formatdesignlist.frm

金算盘软件代码

        End With
    Else
        PaymentMethodIsInActive = False
    End If
End Property

Private Sub UpdateMenuStatus()
    Dim blnIsnotEmpty As Boolean
    Dim blnFindNoChange As Boolean
    With msgTemplate
        If .Rows > 1 And .ColSel <> 0 And .RowHeight(.Row) > 0 Then
            blnIsnotEmpty = True
        Else
            blnIsnotEmpty = False
        End If
    End With
    With frmMain
        .mnuEditEdit.Caption = "修改(&E)"
        .mnuEditNew.Caption = "新增(&N)"
        .mnuEditDel.Caption = "删除(&D)"
        .mnuEditCopy.Enabled = blnIsnotEmpty
        .mnuEditEdit.Enabled = blnIsnotEmpty
        .mnuEditNew.Enabled = True
        .mnuEditDel.Enabled = blnIsnotEmpty
        .mnuEditInActive.Checked = False
        .mnuEditInActive.Visible = False
        .mnuEditInActive.Enabled = blnIsnotEmpty
        .mnuEditShowAll.Checked = chkShowAll.Value
        .mnuEditShowAll.Enabled = True
        .mnuEditUse.Enabled = blnIsnotEmpty
        .mnuEditSearch.Enabled = True
        .mnuEditColumn.Enabled = True
        .mnuEditFilter.Enabled = True
        .mnuFilePrint.Enabled = True
        .mnuFilePrintSetup.Enabled = True
        .mnuReportQuick.Enabled = blnIsnotEmpty
        .mnuToolRefresh.Enabled = True
    End With
    cmdEdit(1).Enabled = blnIsnotEmpty
    If msgTemplate.ColSel = 0 Then  '无当前选定行
        blnFindNoChange = mclsList.FindNoChange
        mclsList.FindNoChange = True
        TxtFind.Text = ""
        mclsList.FindNoChange = blnFindNoChange
        cmdAgain.Enabled = False
    End If
    frmMain.SetToolBar
End Sub

'重画Form
Private Sub RedrawForm()
    '重画MS FlexGrid 控件
    On Error Resume Next
    With msgTemplate
        .Left = ListFormLeft
        .width = Me.ScaleWidth - ListFormLeft - ListFormRight
        .Height = Me.ScaleHeight - ListUpAreaHeight - ListDownAreaHeight
    End With
    
    '重画其余控件
    TxtFind.width = Me.ScaleWidth - TxtFind.Left - ListFormBottom - cmdAgain.width - 15
    cmdAgain.Left = TxtFind.Left + TxtFind.width
    cmdEdit(0).top = Me.ScaleHeight - cmdEdit(0).Height - ListFormBottom
    
    cmdEdit(1).top = cmdEdit(0).top
    chkShowAll.top = cmdEdit(0).top
    chkShowAll.Left = Me.ScaleWidth - chkShowAll.width - ListFormBottom
End Sub

Private Sub Form_Deactivate()
    frmMain.SetEditUnEnabled
End Sub

'
'窗体 Form 控件
'
Private Sub Form_Load()
    Dim i As Integer
    Dim intSortCol As Integer
    On Error GoTo ErrHandle
'    Me.Hide
'    Me.Left = -30000
    MsgForm.PleaseWait
    Me.HelpContextID = 80009
    frmMain.mnuToolReceipt.Tag = Me.hWnd
   
    '付款条件列表窗体初始化
    Debug.Print "Load Start: ", Timer
    Set mclsList = New list
    mclsList.FlexNoChange = True
    mclsList.FindNoChange = True
    Set mclsList.FlexGrid = msgTemplate
    Set mclsList.FindKind = cboFindKind
    Set mclsList.Find = TxtFind
    Set mclsList.Again = cmdAgain
    Debug.Print "Load ListSet Start: ", Timer
    mclsList.ListSet.ViewId = intViewID
    Debug.Print "Load ListSet End: ", Timer
    mclsList.InitFlexGrid
    Debug.Print "Load Recorset Strat: ", Timer
    
'    '得到付款条件列表记录集
'    Set datPaymentMethod.Resultset = GetList()
'    If datPaymentMethod.Resultset.RowCount > 0 Then datPaymentMethod.Resultset.MoveLast
'    datPaymentMethod.Resultset.Close
'    Debug.Print "Load Recorset End: ", Timer
'    mclsList.SetFlexGrid
'
'    '初始化查找复合列表框
'    mclsList.InitcboFindKind
'    mclsList.FlexNoChange = False
'    mclsList.FindNoChange = False
'
'    '设置第一行为选定行
'    With msgTemplate
'        If .Rows > 1 Then msgTemplate.Row = 1
'        .col = 0
'        .ColSel = .Cols - 1
'    End With
'    mclsList.DoShowAll False
'    UpdateMenuStatus
    Debug.Print "Load MainControl Strat: ", Timer
    Set mclsMainControl = gclsSys.MainControls.Add(Me)
    Debug.Print "Load MainControl End: ", Timer
    
    '设置钩子对象
    Set mclsSubClass = New SubClass32.SubClass
    mclsSubClass.hWnd = msgTemplate.hWnd
    mclsSubClass.Messages(WM_PAINT) = True
    mclsSubClass.Messages(WM_LBUTTONUP) = True
    mclsSubClass.Messages(WM_LBUTTONDOWN) = True
    mclsSubClass.Messages(WM_MOUSEMOVE) = True
    Set mclsSubClassform = New SubClass32.SubClass
    mclsSubClassform.hWnd = Me.hWnd
    mclsSubClassform.Messages(WM_GETMINMAXINFO) = True
    Debug.Print "Load End: ", Timer
'    If GetCol("所属单据") > 0 Then mclsList.FlexGrid.ColWidth(GetCol("所属单据")) = 0
    Unload MsgForm
     Exit Sub
    Dim edtErrReturn As ErrDealType
ErrHandle:
    edtErrReturn = Errors.ErrorsDeal
    If edtErrReturn = edtResume Then
         Resume
    Else
         On Error Resume Next
         Unload MsgForm
         Unload Me
    End If
End Sub

'右键菜单
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Button = vbRightButton And frmMain.ActiveForm Is Me Then
        UpdateMenuStatus
        MakeListEditMenu
        mblnEdit = False
        mblnNew = False
        PopupMenu frmMain.mnuListEdit
        If mblnEdit Then
            mclsMainControl_EditEdit
            mblnEdit = False
        End If
        If mblnNew Then
            mclsMainControl_EditNew
            mblnNew = False
        End If
    End If
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    If mIsShowCard Then
        MsgBox "请先关闭模版卡片！", vbExclamation
        Cancel = True
        FrmNewTemplate.Show
        FrmNewTemplate.ZOrder 0
    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
    On Error Resume Next
    mclsList.SaveListSet
    mblnEdit = False
    mblnNew = False
    frmMain.mnuToolReceipt.Tag = 0
    Set mclsSubClass = Nothing
    Set mclsSubClassform = Nothing
    Set mclsList = Nothing
    
    gclsSys.MainControls.Remove Me
    Set mclsMainControl = Nothing
End Sub

Private Sub Form_Resize()
'    If mblnFormNoRezise Then Exit Sub
    On Error Resume Next
    If Me.WindowState = 1 Then Exit Sub
    If Me.Left + Me.width < 0 Or Me.Left > Screen.width Then
       Me.Left = 300
    End If
'    If Me.Height < intFormHeight Then Me.Height = intFormHeight
'    If Me.Width < intFormWidth Then Me.Width = intFormWidth
'    Debug.Print "dujian"
    'mclsList.gridLineRefresh
    RedrawForm
End Sub

Private Sub Form_Activate()
    SetHelpID 80009
    gclsSys.CurrFormName = Me.hWnd
    
    mclsMainControl_ChildActive
'    If msgTemplate.Enabled Then msgTemplate.SetFocus
    msgTemplate.Redraw = True
    UpdateMenuStatus
    If (Me.Left + Me.width < 0 Or Me.Left > Screen.width) Then Me.Left = 300
    If Me.WindowState = 1 Then Me.WindowState = 0
End Sub
Private Sub Form_KeyPress(KeyAscii As Integer)
    On Error Resume Next
    If KeyAscii = vbKeyEscape Then
        Unload Me
    ElseIf KeyAscii = vbKeyReturn Then
        BKKEY Me.ActiveControl.hWnd, vbKeyTab
    End If
End Sub
'
'显示全部记录/未停用记录 CheckBox 控件
'
Private Sub chkShowAll_Click()
    msgTemplate.Redraw = False
    mclsList.DoShowAll chkShowAll.Value
    msgTemplate.Redraw = True
End Sub

'
'查找条件类型 ComboBox 控件
'
Private Sub cboFindKind_Click()
    Dim i As Integer
    Dim intWidth As Integer
    Dim strFind As String
    Dim intSortCol As Integer
    mclsList.ReGetColCaption
    With msgTemplate
        .Redraw = False
        For i = 1 To .Cols - 1
            If .TextMatrix(0, i) = cboFindKind.Text Then
                '保存新排序列内容
                If .RowHeight(.Row) > 0 Then strFind = .TextMatrix(.Row, i)
                '重新排序
                mclsList.FixrowSortBold i
                Exit For
            End If
       Next
    End With
    
    '恢复以前选定行
    If msgTemplate.Rows > 1 Then
        If TxtFind.Text = strFind Then
            txtFind_Change
        Else
            TxtFind.Text = strFind
        End If
    End If
    msgTemplate.Redraw = True
End Sub


Private Sub mclsMainControl_ChildActive()
     Dim vntMessage As Variant
    '响应消息
    
    SetHelpID Me.HelpContextID
    gclsSys.CurrFormName = Me.hWnd
    For Each vntMessage In mclsMainControl.Messages
        If vntMessage = Message.msgTemplate Then
            mclsMainControl_ToolRefresh
            mclsMainControl.Messages.Remove CStr(vntMessage) '清除模板改变消息
        End If
    Next
    mclsMainControl.Messages.Clear
    UpdateMenuStatus
End Sub

Private Sub mclsMainControl_EditColumn()
  Dim strFind As String
    Dim strSort As String
    Dim intCount As Integer
    
    With msgTemplate
        strFind = .TextMatrix(.Row, mclsList.SortCol)
        strSort = cboFindKind.Text
        If mclsList.ListSet.ShowListSet(intViewID) Then
            .Redraw = False
            msgTemplate.Cols = 0
            Set datPaymentMethod.Resultset = GetList()
            If datPaymentMethod.Resultset.RowCount > 0 Then datPaymentMethod.Resultset.MoveLast
            datPaymentMethod.Resultset.Close
            mclsList.SetFlexGrid
            UpdateMenuStatus
            '初始化查找复合列表框
            mclsList.InitcboFindKind
            For intCount = 0 To cboFindKind.ListCount - 1
                If cboFindKind.list(intCount) = strSort Then
                    TxtFind.Text = strFind
                    Exit For
                End If
            Next intCount
            If chkShowAll.Value = 0 Then mclsList.DoShowAll False
            .Redraw = True
        End If
    End With
End Sub

Private Sub mclsMainControl_EditDel()
        Dim lngID As Long
        lngID = GettemplateID
        If mIsShowCard Then
            If lngID = FrmNewTemplate.UsingID And lngID > 0 Then
                MsgBox "不能删除正在编辑的模板", vbExclamation
                FrmNewTemplate.Show
                FrmNewTemplate.ZOrder 0
                Exit Sub
            End If
        End If
        
        If FrmNewTemplate.DelCard(GettemplateID) Then
'            With msgTemplate
'                .RowHeight(.Row) = 0
'                .RowData(.Row) = 1
'                mclsList.SetFlexRow
'            End With
'            gclsSys.SendMessage Me.hwnd, Message.msgTemplate
            mclsMainControl_ToolRefresh
        End If
        UpdateMenuStatus
        Unload FrmNewTemplate
End Sub

Private Sub mclsMainControl_EditEdit()
    Me.Enabled = False
    If GettemplateID > 0 Then FrmNewTemplate.EditCard GettemplateID, , GettemplateTypeID()
    Me.Enabled = True
End Sub

Private Sub mclsMainControl_EditFilter()
    Dim blnFlage As Boolean
    If mclsList.ListSet.ListID < 1 Then mclsList.ListSet.SaveList
    Filter.ShowFilter mclsList.ListSet.ListID, 1, , , , , blnFlage
    If Not blnFlage Then Exit Sub
    mclsList.SaveListSet
    mclsList.ListSet.ViewId = intViewID
    msgTemplate.Cols = 0
    Set datPaymentMethod.Resultset = GetList()
    If datPaymentMethod.Resultset.RowCount > 0 Then datPaymentMethod.Resultset.MoveLast
    datPaymentMethod.Resultset.Close
    mclsList.SetFlexGrid
    UpdateMenuStatus
    '初始化查找复合列表框
    mclsList.InitcboFindKind
    If chkShowAll.Value = 0 Then mclsList.DoShowAll False
End Sub

Private Sub mclsMainControl_EditNew()
    FrmNewTemplate.AddCard
End Sub

'打印设置
Private Sub mclsMainControl_FilePrintSetup()
    Dim MyPrintSet As PrintClass
    Set MyPrintSet = New PrintClass
    MyPrintSet.PrintSetUp gclsBase.BaseDB, mclsList.FlexGrid, , , , 60, " " & Chr(1) & gclsBase.BaseName & Chr(1) & gclsBase.OperatorName
    Set MyPrintSet = Nothing
End Sub

'钩子处理
Private Sub mclsSubClass_WndProc(Msg As Long, wParam As Long, lParam As Long, Result As Long)
    mclsList.HookProc Msg, wParam, lParam, mclsSubClass
    'mclsSubClass.CallWndProc Msg, wParam, lParam
End Sub


'
'查找内容 TextBox 控件
'
Private Sub txtFind_Change()
    mclsList.TextFind TxtFind.Text
End Sub

'钩子处理
Private Sub mclsSubClassForm_WndProc(Msg As Long, wParam As Long, lParam As Long, Result As Long)
    Dim MinMax As MINMAXINFO

    If Msg = WM_GETMINMAXINFO Then
        CopyMemory MinMax, ByVal lParam, Len(MinMax)
        
        MinMax.ptMinTrackSize.x = 430
        MinMax.ptMinTrackSize.y = 250
        
        CopyMemory ByVal lParam, MinMax, Len(MinMax)
        Result = 0
    End If
End Sub

'
' FLEXGRID控件
'

'双击FLEXGRID调用卡片
Private Sub msgtemplate_DblClick()
    If msgTemplate.MouseRow > 0 And msgTemplate.ColSel > 0 And msgTemplate.MouseCol > 1 And msgTemplate.Row > 0 And frmMain.mnuEditEdit.Enabled Then
        'OpenCard GettemplateID()
        FrmNewTemplate.EditCard GettemplateID, , GettemplateTypeID()
    End If
End Sub

'单击FLEXGRID停用列,停用或启用当前记录
Private Sub msgtemplate_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
 Form_MouseDown Button, Shift, x, y
End Sub

'恢复“停用”列光标
Private Sub msgtemplate_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    With msgTemplate
        If Button = vbLeftButton Then
            If chkShowAll.Value = 1 And .ColSel > 0 And .MouseRow > 0 And .Row > 0 Then
                If x > .ColPos(1) And x < .ColPos(2) Then
                    mclsMainControl_EditInActive