frmfreecell.frm

金算盘软件代码

VERSION 5.00
Begin VB.Form frmFreeCell 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "报表自由单元设置"
   ClientHeight    =   1305
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   5760
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   1305
   ScaleWidth      =   5760
   StartUpPosition =   2  '屏幕中心
   Begin VB.CommandButton cmdComplete 
      Default         =   -1  'True
      Height          =   315
      Left            =   2760
      Style           =   1  'Graphical
      TabIndex        =   4
      Top             =   915
      Width           =   1215
   End
   Begin VB.CommandButton cmdCancel 
      Cancel          =   -1  'True
      Height          =   315
      Left            =   4200
      Style           =   1  'Graphical
      TabIndex        =   5
      Top             =   915
      Width           =   1215
   End
   Begin VB.ComboBox cboName 
      Height          =   300
      Left            =   240
      Style           =   2  'Dropdown List
      TabIndex        =   1
      Top             =   360
      Width           =   1575
   End
   Begin VB.TextBox txtContent 
      Height          =   315
      Left            =   2400
      TabIndex        =   3
      Top             =   360
      Width           =   3135
   End
   Begin VB.Label LblContent 
      Caption         =   "内容(&C)"
      Height          =   255
      Left            =   2400
      TabIndex        =   2
      Top             =   60
      Width           =   1815
   End
   Begin VB.Label LblName 
      Caption         =   "名称(&N)"
      Height          =   255
      Left            =   240
      TabIndex        =   0
      Top             =   60
      Width           =   855
   End
End
Attribute VB_Name = "frmFreeCell"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'  报表自由单元设置窗体
'  作者：邓强
'  日期：1999.01.22
'
'  引导用户设置自由单元
'  SetCell                          增加或修改自由单元

Option Explicit
Private mblnOk As Boolean
Private mstrName As String
Private mintFunc As Integer

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'                                   公共过程

'设置自由单元
Public Function SetCell(strName As String, intFunc As Integer) As Boolean
Dim edtErrReturn As ErrDealType
    On Error GoTo ErrHandle
    
    mstrName = strName
    mintFunc = intFunc
    
    cboName.Clear
    cboName.AddItem "自定义" & Space(100) & "0"
'    cboName.AddItem "日期" & Space(100) & "1"
    cboName.AddItem "打印日期" & Space(100) & "2"
    cboName.AddItem "单位名称" & Space(100) & "3"
    cboName.AddItem "制表" & Space(100) & "4"
    cboName.AddItem "页码" & Space(100) & "5"
    cboName.Text = cboName.list(mintFunc)
    
    InitCell
    IsComplete
    Me.Show vbModal
    
    If mblnOk Then
        strName = mstrName
        intFunc = mintFunc
    End If
    SetCell = mblnOk
    Exit Function
ErrHandle:
    edtErrReturn = Errors.ErrorsDeal
    
    If edtErrReturn = edtResume Then
         Resume
    Else
         On Error Resume Next
         Unload Me
    End If
End Function


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'                                   窗体事件
Private Sub cboName_Click()
    If cboName.ListIndex = 0 Then
        txtContent.Enabled = True
        LblContent.Enabled = True
    Else
        txtContent.Enabled = False
        LblContent.Enabled = False
    End If
    IsComplete
End Sub


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

Private Sub txtContent_Change()
    If StrLen(txtContent.Text) > 40 Then
        Utility.ShowMsg Me.hwnd, "自由栏目内容太长!", vbCritical + vbOKOnly, App.title
        txtContent.Text = strLeft(txtContent.Text, 40)
    Else
        IsComplete
    End If
End Sub
Private Sub CmdCancel_Click()
    mblnOk = False
    Unload Me
End Sub

Private Sub cmdComplete_Click()
Dim strSel As String
    strSel = cboName.list(cboName.ListIndex)
    strSel = GetNoXString(strSel, 2, Space(100))
    mintFunc = Val(strSel)
    If mintFunc = 0 Then
        mstrName = txtContent.Text
    Else
        mstrName = GetNoXString(cboName.list(cboName.ListIndex), 1, Space(100))
    End If
'    mintType = cboType.ListIndex + 1
    mblnOk = True
    Unload Me
End Sub
Private Sub Form_Unload(Cancel As Integer)
    Utility.RemoveFormResPicture 1002
    Utility.RemoveFormResPicture 1001
    Utility.RemoveFormResPicture 139
    Set Me.Icon = Nothing
End Sub
Private Sub Form_Load()
    Me.HelpContextID = 10002
    Set Me.Icon = Utility.GetFormResPicture(139, vbResIcon)
End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'                                   私有过程
'初始化设置
Private Sub InitCell()
    cmdCancel.Picture = Utility.GetFormResPicture(1002, vbResBitmap)
    cmdComplete.Picture = Utility.GetFormResPicture(1001, vbResBitmap)
    
    If mintFunc = 0 Then
        txtContent.Text = mstrName
        txtContent.Enabled = True
        LblContent.Enabled = True
    Else
        txtContent.Enabled = False
        LblContent.Enabled = False
    End If
End Sub
'是否可以完成
Private Sub IsComplete()
    If cboName = "自定义" Then
        If Trim(txtContent.Text) = "" Then
            cmdComplete.Enabled = False
        Else
            cmdComplete.Enabled = True
        End If
    Else
        cmdComplete.Enabled = True
    End If
End Sub