frmcopycard.frm

金算盘软件代码

VERSION 5.00
Object = "{D252F124-F62C-11D1-9ABD-444553540000}#1.0#0"; "GADATE.DLL"
Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.3#0"; "COMCTL32.OCX"
Begin VB.Form frmCopyCard 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "复制卡片"
   ClientHeight    =   1935
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   4665
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   1935
   ScaleWidth      =   4665
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  '屏幕中心
   Begin VB.Frame Frame1 
      Height          =   1440
      Left            =   105
      TabIndex        =   5
      Top             =   150
      Width           =   3150
      Begin GACALENDARLibCtl.SpinEdit spinNum 
         Height          =   300
         Left            =   1155
         OleObjectBlob   =   "frmCopyCard.frx":0000
         TabIndex        =   7
         Top             =   915
         Width           =   900
      End
      Begin VB.ComboBox cboCard 
         Height          =   300
         Left            =   1140
         Style           =   2  'Dropdown List
         TabIndex        =   1
         Top             =   285
         Width           =   1920
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "复制张数(&N)"
         Height          =   180
         Index           =   1
         Left            =   120
         TabIndex        =   6
         Top             =   990
         Width           =   990
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "复制卡片(&C)"
         Height          =   180
         Index           =   0
         Left            =   120
         TabIndex        =   0
         Top             =   360
         Width           =   990
      End
   End
   Begin VB.CommandButton cmdOk 
      Height          =   350
      Index           =   0
      Left            =   3375
      Style           =   1  'Graphical
      TabIndex        =   3
      Tag             =   "1001"
      Top             =   240
      UseMaskColor    =   -1  'True
      Width           =   1215
   End
   Begin VB.CommandButton cmdOk 
      Height          =   350
      Index           =   1
      Left            =   3375
      Style           =   1  'Graphical
      TabIndex        =   4
      Tag             =   "1002"
      Top             =   630
      UseMaskColor    =   -1  'True
      Width           =   1215
   End
   Begin ComctlLib.ProgressBar prgCopy 
      Height          =   240
      Left            =   105
      TabIndex        =   2
      Top             =   1650
      Visible         =   0   'False
      Width           =   4455
      _ExtentX        =   7858
      _ExtentY        =   423
      _Version        =   327682
      Appearance      =   1
   End
End
Attribute VB_Name = "frmCopyCard"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'''''''''''''''''''''''''''''''''''''''''''''''
'   复制卡片
'   日期:98-07-03
'
'''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit
Private mblnInit As Boolean
Private mlngFixedCardID As Long

Public Sub Copy(ByVal lngFixedCardID As Long, ByVal blnInit As Boolean)
    mlngFixedCardID = lngFixedCardID
    mblnInit = blnInit
    Load Me
    Show vbModal
End Sub

Private Sub cmdOk_Click(index As Integer)
    Dim lngCnt As Long
    Dim strSql As String
'    Dim recDetail As rdoResultset
    
    Select Case index
        Case 0
            '确定
            If spinNum.Value >= 1 And spinNum.Value <= 100 Then
                CmdOK(0).Enabled = False
                MousePointer = vbHourglass
                CopyCard
                MousePointer = vbDefault
            Else
                ShowMsg hwnd, "复制卡片张数必须在1-100之间！", vbExclamation + vbOKOnly, Caption
                spinNum.SetFocus
                Exit Sub
            End If
        Case 1
            '取消
    End Select
    Unload Me
End Sub

Private Sub Form_Activate()
'    SetHelpID HelpContextID
'    frmMain.SetEditUnEnabled
End Sub

Private Sub Form_Load()
'    me.HelpContextID= 10228
    Utility.LoadFormResPicture Me
    spinNum.Text = "1"
    InitCard
End Sub

Private Sub Form_Unload(Cancel As Integer)
    On Error Resume Next

    Utility.UnLoadFormResPicture Me
End Sub

Private Sub InitCard()
    Dim strSql As String
    Dim recCard As rdoResultset
    Dim lngCnt As Long
    Dim lngOrder As Long
    
    strSql = "SELECT FixedCard.lngFixedCardID,strFixedCode,strFixedName FROM FixedCard , FixedAlter " _
        & " WHERE FixedCard.lngRecentFixedAlterID=FixedAlter.lngFixedAlterID " _
        & "AND FixedCard.lngRecentFixedAlterID=FixedCard.lngCreateFixedAlterID " _
        & "AND FixedAlter.bytAlterType<>2"
    If mblnInit Then
        strSql = strSql & " AND TO_DATE(FixedAlter.strDate,'YYYY-MM-DD')<TO_DATE('" & Format(gclsBase.BeginDate, "yyyy-mm-dd") & "' , 'YYYY-MM-DD') "
    Else
'        strSql = strSql & " AND FixedAlter.strDate>='" & Format(gclsBase.BeginDate, "yyyy-mm-dd") & "' "
    End If
    strSql = strSql & " ORDER BY strFixedCode"
    Set recCard = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    lngCnt = 0
    lngOrder = -1
    Do While Not recCard.EOF
        cboCard.AddItem recCard!strFixedCode & " " & recCard!strFixedName
        If mlngFixedCardID = recCard!lngFixedCardID Then
            lngOrder = lngCnt
        End If
        lngCnt = lngCnt + 1
        recCard.MoveNext
    Loop
    recCard.Close
    Set recCard = Nothing
    If lngOrder >= 0 Then
        cboCard.ListIndex = lngOrder
    End If
End Sub


Private Sub CopyCard()
    Dim lngCnt As Long
    Dim lngCardCount As Long
    Dim strSql As String
    Dim recDetail As rdoResultset
    On Error GoTo ErrHandles
    
    strSql = "SELECT lngFixedCardID,lngCreateFixedAlterID FROM FixedCard  " _
        & "WHERE strFixedCode || ' ' || strFixedName='" & cboCard.Text & "'"
    Set recDetail = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If Not recDetail.EOF Then
        prgCopy.Max = spinNum.Value
        prgCopy.Value = 0
        prgCopy.Visible = True
        Set frmFixedAdd = Nothing
        lngCardCount = 0
        For lngCnt = 1 To spinNum.Value
            prgCopy.Value = lngCnt
            gclsBase.BaseDB.BeginTrans
            If frmFixedAdd.CopyCard(recDetail!lngCreateFixedAlterID, recDetail!lngFixedCardID, , mblnInit) Then
                lngCardCount = lngCardCount + 1
            End If
            gclsBase.BaseDB.CommitTrans
            strSql = "SELECT lngFixedCardID,lngCreateFixedAlterID FROM FixedCard  " _
                & "WHERE strFixedCode || ' ' || strFixedName='" & cboCard.Text & "'"
            Set recDetail = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
        Next lngCnt
ErrHandles:
        Set frmFixedAdd = Nothing
        If lngCardCount > 0 Then
            ShowMsg hwnd, "成功复制" & lngCardCount & "张卡片！", vbInformation + vbOKOnly, Caption
        Else
            ShowMsg hwnd, "复制卡片失败！", vbExclamation + vbOKOnly, Caption
        End If
    End If
    recDetail.Close
    Set recDetail = Nothing
End Sub