frmcurrencylistcard.frm

金算盘软件代码

End Sub

Public Sub EditCard(ByVal lngID As Long, Optional intModal As Integer = 0)
    Dim lngResult As Integer
    
    If lngID = 0 Then
       ShowMsg 0, "币种汇率已不存在，不能修改！", vbExclamation + MB_TASKMODAL, "修改币种汇率"
       Exit Sub
    End If
    mCurrencyIsSave = False
    If mblnIsChanged = True Then
       If mlngCurID > 0 Then
          lngResult = ShowMsg(0, "上一次修改的币种汇率还未保存，是否继续修改它？", _
                         vbYesNoCancel + vbQuestion + MB_TASKMODAL, "修改币种汇率")
          If lngResult = vbYes Then       '继续编辑上一次的固定资产类别
             Me.Show
             Exit Sub
          ElseIf lngResult = vbNo Then
            ' gclsBase.BaseWorkSpace.RollBack
             Unload Me
            ' Exit Sub
          Else
             Me.Hide
             Exit Sub
          End If
       Else
          lngResult = ShowMsg(0, "上一次新增的币种汇率还未保存，是否继续修改它？", _
                         vbYesNoCancel + vbQuestion + MB_TASKMODAL, "修改币种汇率")
          If lngResult = vbYes Then       '继续编辑上一次的固定资产类别
             Me.Show
             Exit Sub
          ElseIf lngResult = vbNo Then
            ' gclsBase.BaseWorkSpace.RollBack
             Unload Me
            ' Exit Sub
          Else
             Me.Hide
             Exit Sub
          End If
       End If
    End If
    'gclsBase.BaseWorkSpace.BeginTrans
    mlngCurID = lngID
   ' mblnIsNew = False
    InitCard
    cmdOk(0).Default = True
    If Me.WindowState = 1 Then Me.WindowState = 0
    Show intModal
    
    If intModal <> vbModal Then
       Refresh
       ZOrder 0
    End If
End Sub

Private Sub Form_Activate()
    gclsSys.CurrFormName = Me.hwnd
End Sub

Private Sub Form_Load()
    SetHelpID Me.hwnd, 30036   '15005
    Utility.LoadFormResPicture Me
    'Set cmdOK(0).Picture = LoadResPicture(1001, vbResBitmap)
    'Set cmdOK(1).Picture = LoadResPicture(1002, vbResBitmap)
    'Set cmdOK(2).Picture = LoadResPicture(1004, vbResBitmap)
    Set mclsMainControl = gclsSys.MainControls.Add(Me)
    Set mclsGrid = New Grid
    Set mclsGrid.Grid = msgRate
    Set mclsGrid.EditText = txtRate
    cboMode.Clear
    cboMode.AddItem "当日"
    cboMode.ItemData(cboMode.NewIndex) = 1
    cboMode.AddItem "向前"
    cboMode.ItemData(cboMode.NewIndex) = 2
    cboMode.AddItem "向后"
    cboMode.ItemData(cboMode.NewIndex) = 3
    frmCurrencysList.IsShowCard(0) = True
End Sub

Private Sub InitCard(Optional strName As String = "")
    Dim recCur As rdoResultset
    Dim strSql As String
    Dim i As Integer
    
    If mlngCurID = 0 Then
       mblnIsNew = True
    Else
       mblnIsNew = False
    End If
    msgRate.ColWidth(2) = 1660
    
    mblnisFirstEdit = True
    If Not mblnIsNew Then
        strSql = "SELECT * FROM Currencys WHERE lngCurrencyID=" & mlngCurID
        Set recCur = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
        If recCur.EOF Then
            ShowMsg 0, "当前币种已被其它用户删除！", vbExclamation + MB_TASKMODAL, Caption
            Unload Me
            Exit Sub
        End If
        mstrOldCurCode = recCur!strCurrencyCode
        txtCurrency(0).Text = mstrOldCurCode
        txtCurrency(1).Text = recCur!strCurrencyName
        txtspin(0).Text = recCur!bytCurrencyDec
        txtspin(1).Text = recCur!bytRateDec
        optMode(1).Value = recCur!blnIsIndirect
        chkStop.Value = IIf(recCur!blnIsInActive, 1, 0)
        cboMode.ListIndex = recCur!bytMatchMethod - 1
        cmdOk(2).Visible = False
        Caption = "修改币种"
        recCur.Close
        If mlngCurID = 1 Then '本位币的处理
           txtspin(0).Text = 2
           txtspin(1).Text = 0
           txtCurrency(0).Enabled = False
           txtCurrency(0).BackColor = &H80000004
           For i = 0 To 1
               txtspin(i).Enabled = False
               txtspin(i).BackColor = &H80000004
           Next
           chkStop.Enabled = False
           cboMode.Enabled = False
           cboMode.BackColor = &H80000004
           'txtspin(1).BackColor = &H80000004
           For i = 0 To 1
               txtspin(i).Enable = False
               optMode(i).Enabled = False
               cboYP(i).Enabled = False
               cboYP(i).BackColor = &H80000004
           Next
           For i = 3 To 7
               lblTitle(i).Enabled = False
           Next
           
           mclsGrid.SetupStyle
           msgRate.Enabled = False
           msgRate.BackColor = &H80000004
           Exit Sub
        End If
           
    Else
        cmdOk(2).Visible = True
        Caption = "新增币种"
        txtCurrency(1).Text = strName
        cboMode.ListIndex = 0
        txtspin(0).Text = 2
        txtspin(1).Text = 4
        optMode(0).Value = True
        optMode(1).Value = False
    End If
    mblnGridIsFirst = True
    initYearPeriod  '初始化年度和期间
    mintOldRow = 1
    mintOldCol = 2
    mblnIsChanged = False
    InitGrid
    mblnGridIsFirst = False
    mblnisFirstEdit = False
    'SendKeys "%{C}"
End Sub
 '初始化年度和期间
Private Sub initYearPeriod()
    Dim strSql As String
    Dim recYP As rdoResultset
    Dim intyear As Integer
    Dim intCount As Integer
    Dim i As Integer
    
    strSql = "select intYear,bytPeriodNO FROM AccountYear order by intYear"
    Set recYP = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If recYP.RowCount <> 0 Then
       cboYP(0).Clear
       Do Until recYP.EOF
          cboYP(0).AddItem recYP.rdoColumns(0)
          recYP.MoveNext
       Loop
       intyear = gclsBase.AccountYear
       If cboYP(0).ListCount > 0 Then
          intCount = cboYP(0).ListCount
          For i = 0 To intCount - 1
              If intyear = cboYP(0).list(i) Then
                 cboYP(0).ListIndex = i
                 Exit For
              End If
          Next
       End If
    End If
End Sub
Private Sub InitForm()

    If txtCurrency(0) = "" Or UCase(txtCurrency(0)) = "TEXT" Then
       txtCurrency(0) = ""
    Else
       txtCurrency(0) = GetNextCode(txtCurrency(0).Text)
       txtCurrency(0).SetFocus
       txtCurrency(0).SelStart = 0
       txtCurrency(0).SelLength = Len(txtCurrency(0).Text)
    End If
    txtCurrency(1) = ""
    txtRate.Text = ""
    mCurrencyIsSave = False
    mlngCurID = 0
    mblnGridIsFirst = True
    initYearPeriod
    mblnGridIsFirst = False
    InitCard
    'SendKeys "%{C}"
End Sub

Private Sub InitGrid()
    Dim dtmSDate As Date, dtmEDate As Date, i As Integer
    Dim recBEDate As rdoResultset, recRate As rdoResultset
    Dim strSql As String, strFormat As String
    
    strFormat = msgRate.FormatString
    msgRate.Clear
    msgRate.FormatString = strFormat
    msgRate.ColWidth(0) = 0
    strSql = "SELECT strStartDate,strEndDate FROM AccountPeriod WHERE " _
        & "intYear=" & mintYear & " AND bytPeriod=" & mbytPeriod
    Set recBEDate = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If recBEDate.EOF Then Exit Sub
    
    dtmSDate = CDate(recBEDate!strStartDate)
    dtmEDate = CDate(recBEDate!strEndDate)
    msgRate.Rows = dtmEDate - dtmSDate + 2
    
  '  If Not mblnIsNew Then
     If mlngCurID <> 0 Then
        strSql = "SELECT * FROM " & "Rate WHERE lngCurrencyID=" & mlngCurID & " AND " _
            & "strDate>='" & Format(recBEDate!strStartDate, "yyyy-mm-dd") _
            & "' AND strDate<='" & Format(recBEDate!strEndDate, "yyyy-mm-dd") & "' ORDER BY strDate"
        Set recRate = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    End If
    For i = 1 To msgRate.Rows - 1
        msgRate.TextMatrix(i, 1) = Format$(dtmSDate, "yyyy-mm-dd")
'        If Not mblnIsNew Then
         If mlngCurID <> 0 Then
            If Not recRate.EOF Then
                If recRate!strDate = msgRate.TextMatrix(i, 1) Then
                    msgRate.TextMatrix(i, 0) = "H"
                    msgRate.TextMatrix(i, 2) = FormatShow(recRate!dblRate, _
                        TxtToDouble(txtspin(1).Text))
                    recRate.MoveNext
                End If
            End If
         End If
         dtmSDate = DateAdd("d", 1, dtmSDate)
    Next i
    recBEDate.Close
    If Not recRate Is Nothing Then recRate.Close
    If msgRate.Rows > 1 Then
       txtRate.Text = msgRate.TextMatrix(1, 2)
       msgRate.Row = 1
    End If
    msgRate.FixedAlignment(1) = flexAlignCenterCenter
    msgRate.FixedAlignment(2) = flexAlignCenterCenter
    msgRate.col = 2
    mclsGrid.SetupStyle
    mclsGrid.SetWriteCol 2
End Sub

Private Sub Form_Paint()
    FrameBox Me.hwnd, 150, 170, 2917.5, 3705
    FrameBox Me.hwnd, 345, 2572.5, 2775, 3510
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    Dim intResponse As Integer
    
    If UnloadMode = vbFormControlMenu Then
        If mblnIsChanged Then
            intResponse = ShowMsg(0, "当前币种汇率已被修改，是否保存？", _
                vbYesNoCancel + vbQuestion + MB_TASKMODAL, Caption)
            If intResponse = vbYes Then
                Cancel = Not UpdateData()
            ElseIf intResponse = vbCancel Then
                Cancel = True
            Else
             '   gclsBase.BaseWorkSpace.RollBack
            End If
        Else
          '  gclsBase.BaseWorkSpace.RollBack
        End If
    End If
    If Not Cancel Then mblnIsChanged = False
End Sub

Private Sub Form_Resize()
    If Me.Left + Me.Width < 0 Or Me.Left > Screen.Width Then
       Me.Left = 300
    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Utility.UnLoadFormResPicture Me
    gclsSys.CurrFormName = ""
    gclsSys.MainControls.Remove Me
    Set mclsMainControl = Nothing
    frmCurrencysList.IsShowCard(0) = False
End Sub




Private Sub mclsGrid_BeforeSave(blnCancel As Boolean)
    Dim i As Integer
    Dim strRate As String
    
    If txtspin(1).Text = 0 Then
       strRate = "0"
    Else
       strRate = "0."
       For i = 1 To Val(txtspin(1).Text)
           strRate = strRate & "0"
       Next
    End If
    
    If txtRate.Text <> "" Then
       txtRate.Text = Format(txtRate.Text, strRate)
       msgRate.TextMatrix(msgRate.Row, 2) = txtRate.Text
       txtRate.Visible = False
    End If
End Sub

Private Sub msgRate_Click()
    With msgRate
         If .Row < 1 Then Exit Sub
         If .col = 2 Then
            txtRate.Text = .TextMatrix(.Row, 2)
         End If
   End With
  
End Sub

'Private Sub Spin_Change(Index As Integer)
'
'     'txtSpin(Index).Text = spin(Index).Value
'     If Index = 1 Then
'        UpdateRate
'     End If
'End Sub

Private Sub UpdateRate()
    Dim i As Integer
    Dim strRate As String
    
    If txtspin(1).Text = 0 Then
       strRate = "0"
    Else
       strRate = "0."
       For i = 1 To Val(txtspin(1).Text)
           strRate = strRate & "0"
       Next
    End If
    With msgRate
         For i = 1 To .Rows - 1
             If .TextMatrix(i, 2) <> "" Then
                .TextMatrix(i, 2) = Format(.TextMatrix(i, 2), strRate)
             End If
         Next
    End With
End Sub

Private Sub optMode_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
mblnIsChanged = True
End Sub

Private Sub optMode_MouseDown(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)
mblnIsChanged = True
End Sub