?? frmdefinelistcard.frm
字號:
VERSION 5.00
Object = "{F42BDC2B-FC9B-11D1-9ABD-444553540000}#3.2#0"; "ATLEDIT.OCX"
Begin VB.Form frmDefineListCard
BorderStyle = 1 'Fixed Single
Caption = "新增自定項目1"
ClientHeight = 2220
ClientLeft = 45
ClientTop = 330
ClientWidth = 6120
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
MDIChild = -1 'True
ScaleHeight = 2220
ScaleWidth = 6120
ShowInTaskbar = 0 'False
Begin AtlEdit.TEdit txtInput
Height = 300
Index = 1
Left = 1800
TabIndex = 3
Top = 1320
Width = 2355
_ExtentX = 4154
_ExtentY = 529
maxchar = 30
RBmenu = 0 'False
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 = ""
End
Begin AtlEdit.TEdit txtInput
Height = 300
Index = 0
Left = 1800
TabIndex = 1
Top = 420
Width = 2355
_ExtentX = 4154
_ExtentY = 529
maxchar = 16
RBmenu = 0 'False
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 = ""
End
Begin VB.CommandButton cmdOK
Cancel = -1 'True
Height = 350
Index = 1
Left = 4680
Style = 1 'Graphical
TabIndex = 6
Tag = "1002"
Top = 661
UseMaskColor = -1 'True
Width = 1215
End
Begin VB.CommandButton cmdOK
Default = -1 'True
Height = 350
Index = 0
Left = 4680
Style = 1 'Graphical
TabIndex = 5
Tag = "1001"
Top = 240
UseMaskColor = -1 'True
Width = 1215
End
Begin VB.CommandButton cmdOK
Height = 350
Index = 3
Left = 4680
Style = 1 'Graphical
TabIndex = 8
Tag = "1013"
Top = 1498
UseMaskColor = -1 'True
Width = 1215
End
Begin VB.CommandButton cmdOK
Height = 350
Index = 2
Left = 4680
Style = 1 'Graphical
TabIndex = 7
Tag = "1009"
Top = 1082
UseMaskColor = -1 'True
Width = 1215
End
Begin VB.CheckBox chkStop
Caption = "停用"
Height = 180
Left = 4680
TabIndex = 4
Top = 1920
Width = 795
End
Begin VB.Label lblTitle
Caption = "自定項目1編碼(&C)"
Height = 225
Index = 0
Left = 360
TabIndex = 0
Top = 495
Width = 1455
End
Begin VB.Label lblTitle
Caption = "自定項目1名稱(&N)"
Height = 195
Index = 1
Left = 360
TabIndex = 2
Top = 1425
Width = 1515
End
End
Attribute VB_Name = "frmDefineListCard"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'功能: 完成自定項目的增、刪、改。
'卡片接口: EditCard 參數: lngID 記錄的ID號
'作用: LNGID為零是增加記錄、其它為編輯記錄
' DelCard 參數: lngID 記錄的ID號
'作用: 刪除ID號為LNGID的記錄
'作者： 蘇濤
Option Explicit
Option Compare Text
Private mblnIsInit As Boolean
Private mblnIsChanged As Boolean
Private mblnIsDetail As Boolean
Private mblnIsNew As Boolean
Private mblnIsInActive As Boolean
Private mblnPIsInActive As Boolean 'NEW--上級停用，EDIT--目的停用
Private mblnPIsDetail As Boolean 'NEW--上級明細，EDIT--目的明細
Private mintLevel As Integer
Private mintOldLevel As Integer
Private mintCustomIndex As Integer
Private mlngPCodeID As Long 'NEW--上級ID，EDIT--目的ID
Private mlngCustomID As Long '當前自定項目ID
Private mstrNotes As String
Private mstrLastCode As String
Private mstrCode As String
Private mstrName As String
Private mstrLastName As String
Private mstrFullName As String
Private mstrOldFullName As String
Private mstrStartDate As String
Private mstrTableName As String
Private WithEvents mclsMainControl As MainControl '主控對象
Attribute mclsMainControl.VB_VarHelpID = -1
Public Property Get getID() As Variant
getID = mlngCustomID
End Property
Public Function AddCard(ByVal strTitleName As String, Optional intModal As Integer, Optional strName As String) As Long
If IsContinue Then Exit Function
mlngCustomID = 0
mblnIsChanged = True
mblnIsNew = True
Caption = "新增" & strTitleName
cmdOk(2).Default = True
lblTitle(0).Caption = strTitleName & "編碼(&C)"
lblTitle(1).Caption = strTitleName & "名稱(&N)"
If SelectTable(strTitleName) Then
InitCard strName
Show intModal
AddCard = mlngCustomID
Refresh
ZOrder 0
Else
ShowMsg 0, "自定項目名標題有錯。", vbExclamation + vbOKOnly + MB_TASKMODAL, Caption
End If
Unload MsgForm
End Function
Public Sub EditCard(ByVal strTitleName As String, ByVal lngID As Long, _
Optional intModal As Integer = 0, Optional strCustom As String = "")
Dim strMess As String
If IsContinue Then Exit Sub
If Not SelectTable(strTitleName) Then
ShowMsg 0, "自定項目名標題有錯。", vbExclamation + vbOKOnly + _
MB_TASKMODAL, "修改自定項目"
Exit Sub
End If
If Not CheckIDUsed(mstrTableName, "lngCustomID", lngID) Then
If Trim(strCustom) <> "" Then
strMess = "“" & strCustom & "”"
Else
strMess = "該"
End If
ShowMsg 0, strMess & "自定項目不存在,不能進行修改！", _
vbExclamation + MB_TASKMODAL, "修改自定項目"
Unload Me
Else
mlngCustomID = lngID
mblnIsNew = False
mblnIsChanged = False
Caption = "修改" & strTitleName
cmdOk(0).Default = True
lblTitle(0).Caption = strTitleName & "編碼(&C)"
lblTitle(1).Caption = strTitleName & "名稱(&N)"
cmdOk(2).Visible = False
cmdOk(3).Move cmdOk(2).Left, cmdOk(2).top
InitCard
Show intModal
Refresh
ZOrder 0
End If
Unload MsgForm
End Sub
Private Function CodeIsUsed(ByVal lngID As Long) As Boolean
Dim strFName As String
CodeIsUsed = True
If lngID <> 0 Then
strFName = "lngCustomID" & mintCustomIndex
If CheckIDUsed("ARAPInit", strFName, lngID) Then Exit Function
If CheckIDUsed("CostPriceDetail", strFName, lngID) Then Exit Function
If CheckIDUsed("Item", strFName, lngID) Then Exit Function
If CheckIDUsed("ItemActivityDetail", strFName, lngID) Then Exit Function
If CheckIDUsed("PurchaseOrderDetail", strFName, lngID) Then Exit Function
If CheckIDUsed("SaleOrderDetail", strFName, lngID) Then Exit Function
If CheckIDUsed("StockTakingDetail", strFName, lngID) Then Exit Function
End If
CodeIsUsed = False
End Function
Private Sub chkStop_Click()
' Dim strDefine As String
'
' strDefine = txtInput(0).Text & " " & txtInput(1).Text
' If chkStop.Value = Checked And Not mblnIsNew Then
' If CodeIsUsed(mlngCustomID) Then
' ShowMsg hwnd, "自定項目“" & strDefine & "“已有業務發生,不能停用！", vbExclamation, Caption
' chkStop.Value = Unchecked
' End If
' End If
If Not mblnIsInit Then mblnIsChanged = True
End Sub
Private Sub cmdOK_Click(Index As Integer)
Dim strNextCode As String
If Index = 0 Then
If Not SaveCard Then Exit Sub
ElseIf Index = 2 Then
If SaveCard Then
strNextCode = GetNextCode(txtInput(0).Text)
' mlngCustomID = 0
InitCard
txtInput(0).Text = strNextCode
txtInput(0).SetFocus
txtInput(0).SelStart = 0
txtInput(0).SelLength = Len(txtInput(0).Text)
End If
Exit Sub
ElseIf Index = 3 Then
mstrNotes = frmNotePad.EditCard(Me.Caption, txtInput(0).Text, _
txtInput(1).Text, mstrNotes) '調記事
Form_Activate
Exit Sub
End If
Unload Me
End Sub
Public Function DelCard(ByVal strTitleName As String, ByVal lngID As Long) As Boolean
Dim recDep As rdoResultset, Strsql As String
Dim strDep As String, strCode As String
If lngID = mlngCustomID And frmCustomList.IsShowCard Then
ShowMsg 0, "不能刪除正在修改的自定項目！", vbExclamation + MB_TASKMODAL, "刪除自定項目"
Show
Exit Function
End If
DelCard = False
If Not SelectTable(strTitleName) Then
ShowMsg 0, "自定項目名標題有錯。", vbExclamation + MB_TASKMODAL, "刪除自定項目"
Exit Function
End If
On Error GoTo ErrHandle
gclsBase.BaseWorkSpace.BeginTrans
If lngID = 0 Then Exit Function
Strsql = "SELECT * FROM " & mstrTableName & " WHERE lngCustomID=" & lngID
Set recDep = gclsBase.BaseDB.OpenResultset(Strsql, rdOpenForwardOnly)
If Not recDep.EOF = True Then
strCode = recDep!strCustomCode
strDep = "“" & Trim(recDep!strCustomCode) & " " _
& Trim(recDep!strCustomName) & "”"
If recDep!blnIsDetail = 0 Then
ShowMsg 0, strDep & "有下級自定項目,不能刪除！", vbExclamation + MB_TASKMODAL, "刪除自定項目"
GoTo ErrHandle
End If
Else
DelCard = True
GoTo ErrHandle
End If
If CodeIsUsed(lngID) Then
ShowMsg 0, "自定項目“" & strDep & "”已有業務發生,不能刪除！", vbExclamation + MB_TASKMODAL, "刪除自定項目"
GoTo ErrHandle
End If
If ShowMsg(0, "你確實要刪除" & strDep & "自定項目嗎？", vbQuestion + vbYesNo + MB_TASKMODAL, _
"刪除自定項目") = vbNo Then GoTo ErrHandle
Strsql = "DELETE FROM " & mstrTableName & " WHERE lngCustomID=" & lngID
If Not gclsBase.ExecSQL(Strsql) Then GoTo ErrHandle
If Not ChangeHigherCardDetail(mstrTableName, "strCustomCode", strCode) Then GoTo ErrHandle
gclsBase.BaseWorkSpace.CommitTrans
DelCard = True
' Select Case CInt(mintCustomIndex)
' Case 0
' gclsSys.SendMessage CStr(Me.hwnd), Message.msgCustom1
' Case 1
' gclsSys.SendMessage CStr(Me.hwnd), Message.msgCustom2
' Case 2
' gclsSys.SendMessage CStr(Me.hwnd), Message.msgCustom3
' Case 3
' gclsSys.SendMessage CStr(Me.hwnd), Message.msgCustom4
' Case 4
' gclsSys.SendMessage CStr(Me.hwnd), Message.msgCustom5
' Case 5
' gclsSys.SendMessage CStr(Me.hwnd), Message.msgCustom6
' End Select
Exit Function
ErrHandle:
gclsBase.BaseWorkSpace.RollbackTrans
End Function
Private Sub Form_Activate()
gclsSys.CurrFormName = Me.hwnd
End Sub
Private Sub Form_Load()
Me.Hide
Me.Left = -30000
MsgForm.PleaseWait
SetHelpID hwnd, 30030
frmCustomList.IsShowCard = True
mblnIsChanged = False
Set mclsMainControl = gclsSys.MainControls.Add(Me)
End Sub
Private Sub Form_Paint()
FrameBox Me.hwnd, 180, 180, 4335, 2000
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Dim intMsgReturn As Integer, strMess As String
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -