📄 formatdesignlist.frm
字号:
VERSION 5.00
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "MSFLXGRD.OCX"
Object = "{0D452EE1-E08F-101A-852E-02608C4D0BB4}#2.0#0"; "FM20.DLL"
Object = "{F6125AB1-8AB1-11CE-A77F-08002B2F4E98}#2.0#0"; "MSRDC20.OCX"
Begin VB.Form frmDesignList
AutoRedraw = -1 'True
BackColor = &H80000004&
Caption = "单据模版"
ClientHeight = 3690
ClientLeft = 2190
ClientTop = 1800
ClientWidth = 6570
KeyPreview = -1 'True
LinkTopic = "Form1"
LockControls = -1 'True
MDIChild = -1 'True
ScaleHeight = 3690
ScaleWidth = 6570
ShowInTaskbar = 0 'False
WhatsThisButton = -1 'True
WhatsThisHelp = -1 'True
Begin MSRDC.MSRDC datPaymentMethod
Height = 330
Left = 5070
Top = 3450
Visible = 0 'False
Width = 1365
_ExtentX = 2408
_ExtentY = 582
_Version = 393216
Options = 0
CursorDriver = 0
BOFAction = 0
EOFAction = 0
RecordsetType = 1
LockType = 3
QueryType = 0
Prompt = 3
Appearance = 1
QueryTimeout = 30
RowsetSize = 100
LoginTimeout = 15
KeysetSize = 0
MaxRows = 0
ErrorThreshold = -1
BatchSize = 15
BackColor = -2147483643
ForeColor = -2147483640
Enabled = -1 'True
ReadOnly = 0 'False
Appearance = -1 'True
DataSourceName = ""
RecordSource = ""
UserName = ""
Password = ""
Connect = ""
LogMessages = ""
Caption = "MSRDC1"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin VB.TextBox TxtFind
Height = 285
Left = 3180
TabIndex = 3
Top = 120
Width = 2955
End
Begin VB.CheckBox chkShowAll
Caption = "全部显示"
Height = 350
Left = 3795
TabIndex = 8
Top = 3210
Width = 1095
End
Begin VB.CommandButton cmdAgain
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 300
Left = 6135
Style = 1 'Graphical
TabIndex = 4
Tag = "1017"
ToolTipText = "再找"
Top = 90
UseMaskColor = -1 'True
Width = 300
End
Begin VB.ComboBox cboFindKind
Height = 276
Left = 720
Style = 2 'Dropdown List
TabIndex = 1
Top = 90
Width = 1515
End
Begin MSFlexGridLib.MSFlexGrid msgTemplate
Bindings = "FormatDesignList.frx":0000
Height = 2655
Left = 90
TabIndex = 5
Tag = "ctPayMethod////"
Top = 480
Width = 6495
_ExtentX = 11456
_ExtentY = 4683
_Version = 393216
Rows = 20
Cols = 3
FixedCols = 0
BackColor = 16777215
BackColorFixed = -2147483644
BackColorSel = -2147483646
BackColorBkg = 16777215
Redraw = -1 'True
AllowBigSelection= 0 'False
FocusRect = 0
SelectionMode = 1
AllowUserResizing= 1
End
Begin MSForms.CommandButton cmdEdit
Height = 345
Index = 1
Left = 1260
TabIndex = 7
Top = 3210
WhatsThisHelpID = 5010
Width = 1215
Caption = "编辑模版"
PicturePosition = 196613
Size = "2143;609"
FontName = "宋体"
FontHeight = 180
FontCharSet = 134
FontPitchAndFamily= 34
ParagraphAlign = 3
End
Begin VB.Label lblFind
AutoSize = -1 'True
Caption = "内容(&C)"
Height = 180
Left = 2460
TabIndex = 2
Top = 150
Width = 630
End
Begin VB.Label lblFindKind
AutoSize = -1 'True
Caption = "查找(&B)"
Height = 180
Left = 50
TabIndex = 0
Top = 150
Width = 630
End
Begin MSForms.CommandButton cmdEdit
Height = 350
Index = 0
Left = 50
TabIndex = 6
Tag = "1018"
Top = 3207
WhatsThisHelpID = 5010
Width = 1215
Caption = "编辑"
PicturePosition = 196613
Size = "2143;617"
FontName = "宋体"
FontHeight = 180
FontCharSet = 134
FontPitchAndFamily= 34
ParagraphAlign = 3
End
End
Attribute VB_Name = "frmDesignList"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
''''''''''''''''''''''''''''''''''''''''''''''
'单据模版列表
'Author Hebing 1998.6
'
'功能：完成对单据模板的管理操作；
'
'公用变量：
'
'Public mIsShowCard As Boolean
'
'其余变量参见列表模版
'
Option Explicit
Private mIsShowCard As Boolean '卡片窗口显示标志
Private mblnCheckNoChange As Boolean '不需要响应chkshowAll控件Change事件
Private mblnFormNoRezise As Boolean '不需要响应form_Rezise事件
Private WithEvents mclsMainControl As MainControl '主控对象
Attribute mclsMainControl.VB_VarHelpID = -1
Private WithEvents mclsSubClass As SubClass32.SubClass '钩子对象
Attribute mclsSubClass.VB_VarHelpID = -1
Private mclsList As list '列表对象
Attribute mclsList.VB_VarHelpID = -1
Private WithEvents mclsSubClassform As SubClass32.SubClass '钩子对象
Attribute mclsSubClassform.VB_VarHelpID = -1
'Public mblTemplateVisible As Boolean '卡片窗口显示标志
Private Const strInActiveColName = "blnIsInActive"
Private Const intViewID = 37
Private Const intFormWidth = 5100
Private Const intFormHeight = 3000
Private mblnLoad As Boolean
Private mblnEdit As Boolean
Private mblnNew As Boolean
Public Function Showlist(ByVal lngID As Long) As Boolean
Dim intCount As Integer
Dim strSortField As String
Dim strSortDec As String
Dim strSql As String
Dim recTemp As rdoResultset
Dim strofFrom As String
Dim strofWhere As String
' If mblnLoad Then
' Me.Show
' Me.ZOrder 0
' Else
' Me.BindingResultSet
' End If
With frmMain.mnuToolReceipt
If IsNumeric(.Tag) Then
If CLng(.Tag) > 0 Then
BringWindowToTop .Tag
Else
Me.BindingResultSet
End If
Else
Me.BindingResultSet
End If
End With
With mclsList.ListSet
'得到排序字段
For intCount = 1 To .Columns
If .ColumnOrderType(intCount) <> 0 Then
strSortField = .ColumnFieldName(intCount)
strSortDec = .ColumnDesc(intCount)
Exit For
End If
Next
If intCount > .Columns Then
Showlist = False
Exit Function
End If
strofFrom = .FromOfSql
strofWhere = .WhereOfSql
End With
'根据lngID得到排序字段值
strSql = "Select " & strSortField & " As " & strSortDec
If Trim(strofWhere) <> "" Then
strofWhere = " where " & strofWhere & " and FormatDesignQuery.lngTemplateID=" & lngID
Else
strofWhere = " where FormatDesignQuery.lngTemplateID=" & lngID
End If
strSql = strSql & strofFrom & strofWhere
Set recTemp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
With recTemp
If .RowCount > 0 Then
TxtFind.Text = recTemp(strSortDec) '查找
If msgTemplate.TextMatrix(msgTemplate.Row, 0) = lngID Then '是否找到
Showlist = True
Else
Showlist = False
End If
Else
Showlist = False
End If
.Close
End With
End Function
'
'方法及函数
'
Public Function GetList() As rdoResultset
Dim recRecordset As rdoResultset
Dim strSelectOfSql As String
Dim strFromOfSql As String
Dim strWhereOfSql As String
Dim strSql As String
strSelectOfSql = mclsList.ListSet.GetSelect
strFromOfSql = mclsList.ListSet.FromOfSql
strWhereOfSql = mclsList.ListSet.WhereOfSql
strSelectOfSql = "Select FormatDesignQuery.lngTemplateID As id,decode(FormatDesignQuery.blnIsInActive,1,'√','') As ""停用""," & strSelectOfSql
#If conVersionType = 4 Then
If Trim(strWhereOfSql) <> "" Then
strWhereOfSql = " Where " & strWhereOfSql & " And FormatDesignQuery.lngReceiptTypeID Not IN (6,7,9,18,19,21,17,26,29,32,45,47) and FormatDesignQuery.bytVersion IN (4,5,6,7,12,13,14,15,20,21,22,23,28,29,30,31)"
Else
strWhereOfSql = " Where FormatDesignQuery.lngReceiptTypeID Not IN (6,7,9,18,19,21,17,26,29,32,45,47) and FormatDesignQuery.bytVersion IN (4,5,6,7,12,13,14,15,20,21,22,23,28,29,30,31) "
End If
#ElseIf conVersionType = 8 Then
If Trim(strWhereOfSql) <> "" Then
strWhereOfSql = " Where " & strWhereOfSql & " And FormatDesignQuery.lngReceiptTypeID Not IN (6,7,17,29,38,47,48,49,50,51,32) and FormatDesignQuery.bytVersion IN (8,9,10,11,12,13,14,15,24,25,26,27,28,29,30,31)"
Else
strWhereOfSql = " Where FormatDesignQuery.lngReceiptTypeID Not IN (6,7,17,29,38,47,48,49,50,51,32) and FormatDesignQuery.bytVersion IN (8,9,10,11,12,13,14,15,24,25,26,27,28,29,30,31) "
End If
#ElseIf conVersionType = 16 Then
If gclsBase.ControlAccount Then
If Trim(strWhereOfSql) <> "" Then
strWhereOfSql = " Where " & strWhereOfSql & " And FormatDesignQuery.lngReceiptTypeID IN (2,13,34,35,36,37,38,39,40,41,48,49,50,51,53,54,55) and FormatDesignQuery.bytVersion IN (16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31)" _
& " AND FormatDesignQuery.lngTemplateID Not IN (123,151)"
Else
strWhereOfSql = " Where FormatDesignQuery.lngReceiptTypeID IN (2,13,34,35,36,37,38,39,40,41,48,49,50,51,53,54,55) and FormatDesignQuery.bytVersion IN (16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31)" _
& " AND FormatDesignQuery.lngTemplateID Not IN (123,151)"
End If
Else
If Trim(strWhereOfSql) <> "" Then
strWhereOfSql = " Where " & strWhereOfSql & " And FormatDesignQuery.lngReceiptTypeID IN (41,48,49,50,51,53,54,55) and FormatDesignQuery.bytVersion IN (16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31)"
Else
strWhereOfSql = " Where FormatDesignQuery.lngReceiptTypeID IN (41,48,49,50,51,53,54,55) and FormatDesignQuery.bytVersion IN (16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31)"
End If
End If
#ElseIf conVersionType = 1 Then
If Trim(strWhereOfSql) <> "" Then
strWhereOfSql = " Where " & strWhereOfSql & " and FormatDesignQuery.bytVersion IN (1,3,5,7,9,11,13,15,17,19,21,23,25,27,29,31) "
Else
strWhereOfSql = " Where FormatDesignQuery.bytVersion IN (1,3,5,7,9,11,13,15,17,19,21,23,25,27,29,31) "
End If
#ElseIf conVersionType = 2 Then
If Trim(strWhereOfSql) <> "" Then
strWhereOfSql = " Where " & strWhereOfSql & " and FormatDesignQuery.bytVersion IN (2,3,6,7,10,11,14,15,18,19,22,23,26,27,30,31) "
Else
strWhereOfSql = " Where FormatDesignQuery.bytVersion IN (2,3,6,7,10,,11,14,15,18,19,22,23,26,27,30,31) "
End If
#End If
If gclsBase.AccountSys = 3 Then
strWhereOfSql = strWhereOfSql & " AND FormatDesignQuery.lngTemplateID Not IN (84,85,86,87,88,89,174)"
Else
strWhereOfSql = strWhereOfSql & " AND FormatDesignQuery.lngTemplateID Not IN (168,169,170,171,172,173,175)"
End If
strSql = strSelectOfSql & strFromOfSql & strWhereOfSql
'Debug.Print strSql
Set recRecordset = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
'列表是否为空
If recRecordset.RowCount = 0 Then
msgTemplate.HighLight = flexHighlightNever
cmdAgain.Enabled = False
Else
msgTemplate.HighLight = flexHighlightAlways
cmdAgain.Enabled = True
End If
Set GetList = recRecordset
mclsList.ShowAll = True
End Function
Public Property Let IsShowCard(ByVal vNewValue As Boolean)
mIsShowCard = vNewValue
End Property
Private Function UpdatePaymentMethodInActive(ByVal lngID As Long, ByVal blnIsInActive As Boolean) As Boolean
Dim strSql As String
strSql = "UPDATE template SET blnIsInActive = " & IIf(blnIsInActive, 1, 0) & " WHERE lngTemplateID = " & lngID
UpdatePaymentMethodInActive = gclsBase.ExecSQL(strSql)
End Function
Private Function DelByPaymentMethodID(ByVal lngID As Long) As Boolean
Dim strSql As String
Dim lngPrintSetupID As Long
Dim lngTitleFontID As Long
Dim lngPageHeaderFontID As Long
Dim lngDataFontID As Long
Dim recRecordset As rdoResultset
strSql = "Select PrintSetup.lngPrintSetupID,PrintSetup.lngTitleFontID,PrintSetup.lngPageHeaderFontID,PrintSetup.lngDataFontID from PrintSetup,Template where PrintSetup.lngPrintSetupID = Template.lngPrintSetupID and template.lngTemplateID = " & lngID
Set recRecordset = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
With recRecordset
If Not .EOF Then
lngPrintSetupID = .rdoColumns(0)
lngTitleFontID = .rdoColumns(1)
lngPageHeaderFontID = .rdoColumns(2)
lngDataFontID = .rdoColumns(3)
End If
.Close
End With
strSql = "Delete From Font Where lngFontID = " & lngTitleFontID & _
" or lngFontID = " & lngPageHeaderFontID & " or lngFontID =" & lngDataFontID
gclsBase.ExecSQL (strSql)
strSql = "Delete From PrintSetup Where lngPrintSetupID = " & lngPrintSetupID
gclsBase.ExecSQL (strSql)
strSql = "Delete From templateFormat Where lngTemplateID = " & lngID
gclsBase.ExecSQL (strSql)
strSql = "Delete From template Where lngTemplateID = " & lngID
DelByPaymentMethodID = gclsBase.ExecSQL(strSql)
End Function
Private Function IsUsePaymentMethodID(ByVal lngID As Long) As Boolean
Dim recRecordset As rdoResultset
Dim strSql As String
strSql = "Select lngtemplateID From Activity Where lngtemplateID = " & lngID
Set recRecordset = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
IsUsePaymentMethodID = (recRecordset.RowCount >= 1)
recRecordset.Close
End Function
Public Property Get PaymentMethodID() As Long
With msgTemplate
PaymentMethodID = CLng(.TextArray(.Row * .Cols))
End With
End Property
Public Property Get PaymentMethodIsInActive() As Boolean
If chkShowAll.Value Then
With msgTemplate
PaymentMethodIsInActive = Not (.TextArray(.Row * .Cols + 1) = "")
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -