frmfixeddefinecard.frm

金算盘软件代码

VERSION 5.00
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "MSFLXGRD.OCX"
Object = "{F42BDC2B-FC9B-11D1-9ABD-444553540000}#3.4#0"; "ATLEDIT1.OCX"
Begin VB.Form frmFixedDefineCard 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "固定资产类别自定项目设置"
   ClientHeight    =   6000
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   4680
   Icon            =   "frmFixedDefineCard.frx":0000
   KeyPreview      =   -1  'True
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   6000
   ScaleWidth      =   4680
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  '屏幕中心
   Begin AtlEdit.TEdit txtPaste 
      Height          =   225
      Left            =   780
      TabIndex        =   4
      TabStop         =   0   'False
      Top             =   2490
      Visible         =   0   'False
      Width           =   1815
      _ExtentX        =   3201
      _ExtentY        =   397
      maxchar         =   50
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Text            =   ""
      Appearance      =   0
   End
   Begin VB.ComboBox cboFixed 
      Height          =   300
      Left            =   1530
      TabIndex        =   1
      Top             =   240
      Width           =   1665
   End
   Begin MSFlexGridLib.MSFlexGrid msgFixed 
      Height          =   4875
      Left            =   270
      TabIndex        =   3
      Top             =   870
      Width           =   2775
      _ExtentX        =   4895
      _ExtentY        =   8599
      _Version        =   393216
      Rows            =   21
      Cols            =   4
      FixedCols       =   0
      RowHeightMin    =   228
      BackColorFixed  =   -2147483644
      ForeColorSel    =   -2147483643
      BackColorBkg    =   -2147483643
      GridColor       =   0
      ScrollBars      =   0
      FormatString    =   "使用|标题               |类型"
   End
   Begin VB.CommandButton cmdOK 
      Height          =   345
      Index           =   1
      Left            =   3330
      Style           =   1  'Graphical
      TabIndex        =   6
      Tag             =   "1002"
      Top             =   660
      Width           =   1215
   End
   Begin VB.CommandButton cmdOK 
      Height          =   345
      Index           =   0
      Left            =   3330
      Style           =   1  'Graphical
      TabIndex        =   5
      Tag             =   "1001"
      Top             =   240
      Width           =   1215
   End
   Begin VB.Label lblFixed 
      Caption         =   "自定义项目(&D)"
      Height          =   195
      Index           =   1
      Left            =   270
      TabIndex        =   2
      Top             =   600
      Width           =   1185
   End
   Begin VB.Label lblFixed 
      Caption         =   "固定资产类别(&F)"
      Height          =   195
      Index           =   0
      Left            =   150
      TabIndex        =   0
      Top             =   300
      Width           =   1365
   End
End
Attribute VB_Name = "frmFixedDefineCard"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private mblnIsChanged As Boolean
Private mlngTypeID As Long

Public Property Let TypeID(ByVal lngID As Long)
    mlngTypeID = lngID
End Property

Private Sub cboFixed_Click()
    If mlngTypeID <> cboFixed.ItemData(cboFixed.ListIndex) Then
        If mblnIsChanged Then
            If ShowMsg(hwnd, "要保存固定资产类别自定项目设置吗？", vbQuestion + vbYesNo, Caption) = vbYes Then
                SaveCard
            End If
        End If
        mlngTypeID = cboFixed.ItemData(cboFixed.ListIndex)
        InitGrid
    End If
End Sub

Private Sub InitGrid()
    Dim recF As rdoResultset, strSql As String
    Dim b As Byte
    
    With msgFixed
        For b = 1 To 20
            .TextMatrix(b, 0) = ""
            .TextMatrix(b, 1) = "自定项目" & b
            If b < 14 Then
                .TextMatrix(b, 2) = "文本"
            ElseIf b < 19 Then
                .TextMatrix(b, 2) = "数字"
            Else
                .TextMatrix(b, 2) = "日期"
            End If
        Next b
    
        strSql = "SELECT * FROM FixedCustom WHERE lngFixedTypeID=" _
            & mlngTypeID & " ORDER BY lngCustomNo"
        Set recF = gclsBase.BaseDB.OpenResultset(strSql, rdOpenForwardOnly)
        While Not recF.EOF
            .TextMatrix(recF("lngCustomNo"), 0) = "√"
            .TextMatrix(recF("lngCustomNo"), 1) = recF("strCustomName")
            recF.MoveNext
        Wend
        recF.Close
    End With
End Sub

Private Sub cmdOK_Click(Index As Integer)
    If Index = 0 Then
        If mblnIsChanged Then
            If Not SaveCard Then Exit Sub
        End If
    End If
    Unload Me
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
    
    On Error Resume Next
    If KeyAscii = vbKeyReturn Then
        BKKEY Me.ActiveControl.hwnd, vbKeyTab
    ElseIf KeyAscii = vbKeyEscape Then
        cmdOK(1).Value = True
    End If
End Sub

Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyReturn And Shift = 2 Then
        cmdOK(0).Value = True
    End If
End Sub

Private Sub Form_Load()
    
    Utility.LoadFormResPicture Me
    Set msgFixed.MouseIcon = GetFormResPicture(2001, vbResCursor)
    InitComBox
    InitGrid
'    mblnIsChanged = True
End Sub

Private Sub InitComBox()
    Dim recF As rdoResultset, strSql As String, strType As String
    
    cboFixed.Clear
    strSql = "SELECT lngFixedTypeID,strFixedTypeCode,strFixedTypeName " _
        & "FROM FixedType ORDER BY strFixedTypeCode"
    Set recF = gclsBase.BaseDB.OpenResultset(strSql, rdOpenForwardOnly)
    While Not recF.EOF
        If mlngTypeID = recF("lngFixedTypeID") Then
            strType = recF("strFixedTypeCode") & " " & recF("strFixedTypeName")
        End If
        cboFixed.AddItem recF("strFixedTypeCode") & " " & recF("strFixedTypeName")
        cboFixed.ItemData(cboFixed.NewIndex) = recF("lngFixedTypeID")
        recF.MoveNext
    Wend
    recF.Close
    If cboFixed.ListCount > 0 Then
        If strType = "" Then
            cboFixed.ListIndex = 0
        Else
            cboFixed.Text = strType
        End If
    End If
End Sub

Private Sub Form_Paint()
    FrameBox Me.hwnd, 150, 690, 150 + 3045, 690 + 5157
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    Dim intMsgReturn As Integer
    
    If UnloadMode = vbFormControlMenu Then
        If mblnIsChanged Then
            intMsgReturn = ShowMsg(hwnd, "当前固定资产类别自定项目设置已被修改，是否保存？", _
                       vbExclamation + vbYesNoCancel, Caption)
            If intMsgReturn = vbYes Then
                Cancel = Not SaveCard
            ElseIf intMsgReturn = vbCancel Then
                Cancel = True
            End If
        End If
        If Not Cancel Then mblnIsChanged = False
    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
    On Error Resume Next
    Utility.UnLoadFormResPicture Me
End Sub

Private Sub msgFixed_DblClick()
    msgFixed_KeyPress 0
End Sub

Private Sub msgFixed_KeyPress(KeyAscii As Integer)

    If msgFixed.Row = 0 Or msgFixed.col = 2 Then Exit Sub
    
    If msgFixed.col = 0 Then
        If KeyAscii = vbKeySpace Then
            If msgFixed.TextMatrix(msgFixed.Row, 0) = "√" Then
                msgFixed.TextMatrix(msgFixed.Row, 0) = ""
            Else
                msgFixed.TextMatrix(msgFixed.Row, 0) = "√"
            End If
            mblnIsChanged = True
        End If
    ElseIf msgFixed.col = 1 Then
        If InStr("'|""`~", Chr(KeyAscii)) > 0 Then
            EditGrid 0
        Else
            EditGrid KeyAscii
        End If
    End If
End Sub

Private Sub msgFixed_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    Dim i As Integer, lHeigh As Long
    
    With msgFixed
    For i = 0 To .Rows - 1
        lHeigh = lHeigh + .RowHeight(i)
    Next i
    If .MouseCol = 0 And y > .RowHeight(0) And y < lHeigh Then
        .MousePointer = flexCustom
    Else
        .MousePointer = flexDefault
    End If
    End With
End Sub

Private Sub msgFixed_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    
    If Button = vbLeftButton Then
        If msgFixed.MousePointer <> vbDefault Then
            If msgFixed.TextMatrix(msgFixed.Row, 0) = "√" Then
                msgFixed.TextMatrix(msgFixed.Row, 0) = ""
            Else
                msgFixed.TextMatrix(msgFixed.Row, 0) = "√"
            End If
            mblnIsChanged = True
        End If
    End If
End Sub

Private Function SaveCard() As Boolean
    Dim strSql As String, b As Byte
    
    SaveCard = False
    
    If Not DataValid Then Exit Function
    strSql = "DELETE FROM FixedCustom WHERE lngFixedTypeID=" & mlngTypeID
    If Not gclsBase.ExecSQL(strSql) Then Exit Function
    
    For b = 1 To 20
        If msgFixed.TextMatrix(b, 0) = "√" Then
            strSql = "INSERT INTO FixedCustom(lngFixedTypeID,lngCustomNO,strCustomName) " _
                & "VALUES(" & mlngTypeID & "," & b & ",'" & msgFixed.TextMatrix(b, 1) & "')"
        Else
            strSql = ""
        End If
        If strSql <> "" Then
            If Not gclsBase.ExecSQL(strSql) Then Exit Function
        End If
    Next b
    SaveCard = True
    mblnIsChanged = False
End Function

Private Function DataValid() As Boolean
    Dim b As Byte

    For b = 1 To 20
        If msgFixed.TextMatrix(b, 0) = "√" Then
            If Trim(msgFixed.TextMatrix(b, 1)) = "" Then
                ShowMsg hwnd, "选择使用的标题不能为空！", vbExclamation, Caption
                Exit Function
            End If
        End If
    Next b
    DataValid = True
End Function

Private Sub EditGrid(ByVal KeyCode As Integer)
    On Error Resume Next

    With msgFixed
        txtPaste.Move .Left + .CellLeft, .top + .CellTop, .CellWidth, .CellHeight
        If KeyCode = 8 Then
            txtPaste.Text = Mid(.Text, 1, Len(.Text) - 1)
        Else
            txtPaste.Text = .Text & Chr(KeyCode)
        End If
        txtPaste.Visible = True
        txtPaste.SetFocus
        txtPaste.SelStart = Len(txtPaste.Text)
        mblnIsChanged = True
    End With
End Sub

Private Sub txtPaste_Change()
    If ContainErrorChar(txtPaste.Text, "'|""`~") Then BKKEY txtPaste.hwnd
    msgFixed.Text = txtPaste.Text
    mblnIsChanged = True
End Sub

Private Sub txtPaste_KeyPress(KeyAscii As Integer)
    
    If InStr("'|""`~", Chr(KeyAscii)) > 0 And KeyAscii <> 8 Then KeyAscii = 0
    If KeyAscii = vbKeyReturn Then
        If msgFixed.Row < msgFixed.Rows - 1 Then
            msgFixed.Row = msgFixed.Row + 1
            EditGrid 0
        End If
    End If
End Sub

Private Sub txtPaste_LostFocus()
    txtPaste.Visible = False
End Sub