www.pudn.com > VB-KAOQINXITONG.zip > frmRestSetup.frm
VERSION 5.00
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCT2.OCX"
Object = "{B9D938CE-50EE-40B2-9FA2-79A3112F4788}#4.1#0"; "BNCtrlGroup.ocx"
Begin VB.Form frmRestSetup
Caption = "休息日/节假日设置"
ClientHeight = 4575
ClientLeft = 60
ClientTop = 345
ClientWidth = 7230
Icon = "frmRestSetup.frx":0000
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
NegotiateMenus = 0 'False
ScaleHeight = 4575
ScaleWidth = 7230
StartUpPosition = 2 '屏幕中心
Begin VB.Frame Frame1
Appearance = 0 'Flat
Caption = "休息日设置"
ForeColor = &H80000008&
Height = 810
Left = 210
TabIndex = 0
Top = 3540
Width = 5340
Begin VB.CheckBox chkRestDay
Alignment = 1 'Right Justify
Appearance = 0 'Flat
Caption = "六"
ForeColor = &H80000008&
Height = 270
Index = 6
Left = 4635
TabIndex = 8
Top = 315
Width = 480
End
Begin VB.CheckBox chkRestDay
Alignment = 1 'Right Justify
Appearance = 0 'Flat
Caption = "五"
ForeColor = &H80000008&
Height = 270
Index = 5
Left = 3885
TabIndex = 7
Top = 315
Width = 480
End
Begin VB.CheckBox chkRestDay
Alignment = 1 'Right Justify
Appearance = 0 'Flat
Caption = "四"
ForeColor = &H80000008&
Height = 270
Index = 4
Left = 3138
TabIndex = 6
Top = 315
Width = 480
End
Begin VB.CheckBox chkRestDay
Alignment = 1 'Right Justify
Appearance = 0 'Flat
Caption = "三"
ForeColor = &H80000008&
Height = 270
Index = 3
Left = 2391
TabIndex = 5
Top = 315
Width = 480
End
Begin VB.CheckBox chkRestDay
Alignment = 1 'Right Justify
Appearance = 0 'Flat
Caption = "二"
ForeColor = &H80000008&
Height = 270
Index = 2
Left = 1644
TabIndex = 4
Top = 315
Width = 480
End
Begin VB.CheckBox chkRestDay
Alignment = 1 'Right Justify
Appearance = 0 'Flat
Caption = "一"
ForeColor = &H80000008&
Height = 270
Index = 1
Left = 897
TabIndex = 3
Top = 315
Width = 480
End
Begin VB.CheckBox chkRestDay
Alignment = 1 'Right Justify
Appearance = 0 'Flat
Caption = "日"
ForeColor = &H80000008&
Height = 270
Index = 0
Left = 150
TabIndex = 2
Top = 315
Width = 480
End
End
Begin MSComCtl2.MonthView MonthView1
Height = 3210
Left = 210
TabIndex = 1
Top = 180
Width = 5265
_ExtentX = 9287
_ExtentY = 5662
_Version = 393216
ForeColor = 255
BackColor = 16777215
Appearance = 0
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "Arial"
Size = 12
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
MaxSelCount = 31
MonthBackColor = 16777215
MultiSelect = -1 'True
ShowToday = 0 'False
StartOfWeek = 23724033
TitleBackColor = 8388608
TitleForeColor = 8454143
TrailingForeColor= 16711680
CurrentDate = 36729
MaxDate = 38717
MinDate = 36526
End
Begin BNCtrlGroup.BNButton cmdSave
Height = 345
Left = 5820
TabIndex = 10
Tag = "Save"
Top = 2745
Width = 1125
_ExtentX = 1984
_ExtentY = 609
Caption = "保 存"
CapAlign = 2
BackStyle = 2
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Mode = 0
Value = 0 'False
cBack = -2147483633
End
Begin BNCtrlGroup.BNButton cmdExit
Cancel = -1 'True
Height = 345
Left = 5820
TabIndex = 11
Tag = "Exit"
Top = 3300
Width = 1125
_ExtentX = 1984
_ExtentY = 609
Caption = "退 出"
CapAlign = 2
BackStyle = 2
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Mode = 0
Value = 0 'False
cBack = -2147483633
End
Begin BNCtrlGroup.BNButton cmdOK
Default = -1 'True
Height = 345
Left = 5820
TabIndex = 9
Tag = "OK"
Top = 2190
Width = 1125
_ExtentX = 1984
_ExtentY = 609
Caption = "确 定"
CapAlign = 2
BackStyle = 2
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Mode = 0
Value = 0 'False
cBack = -2147483633
End
Begin VB.Label lblDayStatus
Alignment = 2 'Center
Appearance = 0 'Flat
BackColor = &H00E0E0E0&
BorderStyle = 1 'Fixed Single
Caption = "日状态"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H80000008&
Height = 315
Left = 5715
TabIndex = 12
Top = 210
Width = 1305
End
Begin VB.Menu mnuPopup
Caption = "弹出菜单"
NegotiatePosition= 3 'Right
Visible = 0 'False
Begin VB.Menu mnuFeast
Caption = "设置为节假日"
End
Begin VB.Menu mnuRest
Caption = "设置为休息日"
End
Begin VB.Menu mnuWorkDay
Caption = "设置为工作日"
End
Begin VB.Menu mnuCancel
Caption = "取消"
End
Begin VB.Menu mnuBar
Caption = "-"
End
Begin VB.Menu mnuHoli
Caption = "设置为请假"
Begin VB.Menu mnuHoliday
Caption = "假日"
Index = 0
End
End
End
End
Attribute VB_Name = "frmRestSetup"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'MvwCalendarBack 0 日历背景.
'MvwCalendarDate 1 日历的日期.
'MvwCalendarDateNext 2 如果单击该区域,则日历将显示下一月份.
'MvwCalendarDatePrev 3 如果单击该区域,则日历将显示前一月份.
'MvwCalendarDay 4 该日期上的日期标号.
'MvwCalendarWeekNum 5 星期号,如果 ShowWeekNumbers 被设置为 True.
'MvwNoWhere 6 日历的底边.
'mvwTitleBack 7 日历的背景.
'mvwTitleBtnNext 8 标题区域的Next按钮.
'mvwTitleBtnPrev 9 标题区域的Previous按钮.
'mvwTitleMonth 10 标题的月份字符串.
'mvwTitleYear 11 标题的年份字符串.
'mvwTodayLink 12 如果单击该区域,则该日历将显示当前月份和日期.只有当 ShowToday 被设为 True 时才可用.
Dim adoRestRS As ADODB.Recordset
Private Type RestDay
DMonth As Date
iDataType As Integer '为1数据未改变,2未保存的数据修改数据(数据库中存在),3-新加数据
sRestDay(30) As String
iWeekState(6) As Integer
End Type
Dim miResult As Integer
Dim mDMyDate As Date
Dim mbNoData As Boolean
Dim mTRestDay() As RestDay
Dim mDCurrDay As Date
Dim miDay() As VbDayOfWeek
Dim miDateState(30) As Integer
Dim mbDateChange As Boolean
Const AT_NORMAL = 0 '正常上班
Const AT_REST = 1 '礼拜天
Const AT_FEAST = 2 '法定假
Const AT_HOLIDAY = 3 '请假
Const AT_WORKDAY = 4 '工作日
Dim mbGetFocus As Boolean
Dim mbIgnoreListClick As Boolean
Private Sub LoLoadRestDay()
Dim sSQL As String
Dim n As Integer
Dim sDayState As String
sSQL = "SELECT * FROM T0112S001"
Set adoRestRS = New ADODB.Recordset
With adoRestRS
.Open sSQL, gDBRecordConn, adOpenStatic, adLockOptimistic
n = .RecordCount
If n < 1 Then mbNoData = True: Exit Sub
ReDim mTRestDay(n - 1)
For i = 0 To n - 1
mTRestDay(i).DMonth = !W6627
mTRestDay(i).iDataType = 1
sDayState = gclsInclude.MyNz(!W6628, "")
If sDayState <> "" Then
For j = 0 To Len(sDayState) - 1
mTRestDay(i).sRestDay(j) = Mid(sDayState, j + 1, 1)
Next j
End If
sDayState = gclsInclude.MyNz(!W6629, "")
If sDayState <> "" Then
For j = 0 To Len(sDayState) - 1
mTRestDay(i).iWeekState(j) = Mid(sDayState, j + 1, 1)
Next j
End If
.MoveNext
Next i
End With
End Sub
Private Sub LoSaveRestDay()
Dim i As Integer, n As Integer
Dim j As Integer
Dim lMaxID As Long
Dim sDayState As String
Dim sWeekState As String
n = UBound(mTRestDay)
If n = 0 And mTRestDay(0).iDataType = 1 Then Exit Sub
With adoRestRS
If .RecordCount > 0 Then .MoveFirst
For i = 0 To n
sDayState = ""
sWeekState = ""
If mTRestDay(i).iDataType = 2 Or mTRestDay(i).iDataType = 3 Then
For j = 0 To 30
sDayState = sDayState & mTRestDay(i).sRestDay(j)
Next j
For j = 0 To 6
sWeekState = sWeekState & mTRestDay(i).iWeekState(j)
Next j
End If
If mTRestDay(i).iDataType = 2 Then
If .RecordCount = 0 Then GoTo AddNewLabel
.MoveFirst
.Find "W6627 = '" & mTRestDay(i).DMonth & "'"
If Not .EOF Then
!W6629 = sWeekState
!W6628 = sDayState
.Update
End If
ElseIf mTRestDay(i).iDataType = 3 Then
AddNewLabel:
.AddNew
lMaxID = gclsCommon.CBNGetMaxID("T0112S001"): lMaxID = lMaxID + 1
!ID = lMaxID
!W6629 = sWeekState
!W6628 = sDayState
!W6627 = CStr(mTRestDay(i).DMonth)
.Update
If lMaxID > 0 Then gclsCommon.CBNSetMaxID "T0112S001", lMaxID
End If
Next i
End With
End Sub
Private Sub chkRestDay_Click(Index As Integer)
Dim sSelIndex As String
If mbIgnoreListClick Then Exit Sub
sSelIndex = LoGetWeekDay(Index)
If chkRestDay(Index).Value = 1 Then '法定星期日
LoSetDayState mDCurrDay, AT_REST, sSelIndex
Else
LoSetDayState mDCurrDay, AT_NORMAL, sSelIndex
End If
End Sub
Private Sub cmdExit_Click()
If mbDateChange Then
If MsgBox("数据有所改变,是否保存后退出?", vbYesNo + vbDefaultButton2 + vbExclamation) = vbOK Then
cmdOK_Click
End If
End If
Unload Me
End Sub
Private Sub cmdSave_Click()
LoSaveRestDay
cmdSave.Enabled = False
MsgBox "保存完毕!", vbExclamation
mbDateChange = False
End Sub
Private Sub cmdOK_Click()
If mbDateChange Then LoSaveRestDay
Unload Me
End Sub
Private Sub Form_Load()
LoSetButtonTag
SetIcon Me
ReDim mTRestDay(0)
mbDateChange = False
MonthView1.MultiSelect = False
MonthView1.Year = Year(gclsCommon.CBNGetNow)
MonthView1.Month = Month(gclsCommon.CBNGetNow)
MonthView1.MultiSelect = True
lblDayStatus = ""
LoLoadRestDay
LoAddHolidayMenu
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
If mbGetFocus Then
cmdExit.SetFocus
mbGetFocus = False
End If
End Sub
'Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
'' If MonthView1.Enabled Then MonthView1.Enabled = False
'End Sub
Private Sub Form_Unload(Cancel As Integer)
Set adoRestRS = Nothing
End Sub
Private Sub mnuFeast_Click()
Dim iSelStart As Integer
Dim iSelCount As Integer
Dim sSelIndex As String
sSelIndex = LoGetSelectDay(iSelStart, iSelCount)
If sSelIndex = "" Then Exit Sub
LoSetDayState mDCurrDay, AT_FEAST, sSelIndex
End Sub
Private Sub mnuHoliday_Click(Index As Integer)
Dim iSelStart As Integer
Dim iSelCount As Integer
Dim sSelIndex As String
sSelIndex = LoGetSelectDay(iSelStart, iSelCount)
If sSelIndex = "" Then Exit Sub
LoSetDayState mDCurrDay, AT_HOLIDAY, sSelIndex, mnuHoliday(Index).Tag
End Sub
Private Sub mnuRest_Click()
LoSetDayState mDCurrDay, AT_REST, LoGetSelectDay
End Sub
Private Sub mnuCancel_Click()
LoSetDayState mDCurrDay, AT_NORMAL, LoGetSelectDay
End Sub
'得到星期X的一系列天索引
Private Function LoGetWeekDay(ByVal fiWeekIndex As Integer) As String
Dim iFirstIndex As Integer
Dim i As Integer
iFirstIndex = Weekday(mDCurrDay) - 1 ' 日历启动时显示的第一天所在的起点(星期)
For i = 0 To 30
If (iFirstIndex + i) Mod 7 = fiWeekIndex Then
LoGetWeekDay = LoGetWeekDay & "," & i
End If
Next i
LoGetWeekDay = Mid(LoGetWeekDay, 2)
End Function
Private Function LoGetSelectDay(Optional iIndex As Integer, Optional iSelCount As Integer) As String
Dim iFirstIndex As Integer
Dim iSelStart As Integer
Dim DSelFirst As Date
Dim i As Integer
If MonthView1.SelEnd < mDCurrDay Then
MsgBox "请在当月选择", vbExclamation
Exit Function
ElseIf MonthView1.SelStart < mDCurrDay Then
DSelFirst = mDCurrDay
ElseIf Month(MonthView1.SelEnd) > Month(mDCurrDay) Then
MsgBox "请在当月选择", vbExclamation
Exit Function
Else
DSelFirst = MonthView1.SelStart
End If
iFirstIndex = Weekday(mDCurrDay) - 1 ' 日历启动时显示的第一天所在的起点(星期)
iSelStart = DateDiff("d", mDCurrDay, DSelFirst)
iIndex = iSelStart + iFirstIndex
For i = iSelStart To iSelStart + DateDiff("d", DSelFirst, MonthView1.SelEnd)
LoGetSelectDay = LoGetSelectDay & "," & i
Next i
LoGetSelectDay = Mid(LoGetSelectDay, 2)
End Function
Private Sub mnuWorkDay_Click()
Dim iSelStart As Integer
Dim iSelCount As Integer
Dim sSelIndex As String
sSelIndex = LoGetSelectDay(iSelStart, iSelCount)
If sSelIndex = "" Then Exit Sub
LoSetDayState mDCurrDay, AT_WORKDAY, sSelIndex
End Sub
'自动设置每周
'Private Sub MonthView1_GetDayBold(ByVal StartDate As Date, ByVal Count As Integer, State() As Boolean)
' Dim i As Integer, j As Integer
' Dim iDay(2) As VbDayOfWeek
' If mbNoData Then Exit Sub
' iDay(1) = vbSunday
' iDay(0) = vbSaturday
' iDay(2) = vbThursday
' For i = 1 To Count
' For j = 0 To UBound(iDay)
' If 1 + (i - 1) Mod 7 = 1 + iDay(j) - MonthView1.StartOfWeek Then
' State(i - 1) = True
' End If
' Next j
' Next i
'End Sub
Private Sub MonthView1_GetDayBold(ByVal StartDate As Date, ByVal Count As Integer, State() As Boolean)
Dim i As Integer, j As Integer
Dim nDays As Integer
Dim iFirstDay As Integer
Dim iDay(2) As VbDayOfWeek
mDCurrDay = gclsInclude.MyCDate(MonthView1.Year, MonthView1.Month)
mbIgnoreListClick = True
For j = 0 To 6
If chkRestDay(j).Value = 1 Then chkRestDay(j).Value = 0
Next j
mbIgnoreListClick = False
For i = 0 To UBound(mTRestDay)
If gclsInclude.MyCDate(MonthView1.Year, MonthView1.Month) = mTRestDay(i).DMonth Then
iFirstDay = DateDiff("d", StartDate, mTRestDay(i).DMonth)
nDays = gclsInclude.MyGetDays(mTRestDay(i).DMonth)
For j = 0 To nDays - 1
State(j + iFirstDay) = IIf(mTRestDay(i).sRestDay(j) = "0" Or mTRestDay(i).sRestDay(j) = "", False, True)
Next j
mbIgnoreListClick = True
For j = 0 To 6
chkRestDay(j).Value = mTRestDay(i).iWeekState(j)
Next j
mbIgnoreListClick = False
End If
Next i
End Sub
Private Sub MonthView1_GotFocus()
If Not mbGetFocus Then mbGetFocus = True
End Sub
Private Sub MonthView1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = 2 Then
If miResult <> mvwCalendarDate Then
If miResult = mvwCalendarDateNext Or miResult = mvwCalendarDatePrev Then
' MsgBox "请先选择当月的日期"
Exit Sub
Else
' MsgBox "请先选择要设置的日期"
Exit Sub
End If
Else
If Not LoIsSelect(mDMyDate) Then
MonthView1.SelStart = mDMyDate
MonthView1.SelEnd = mDMyDate
End If
End If
PopupMenu mnuPopup
End If
End Sub
Private Sub MonthView1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
miResult = MonthView1.HitTest(x, y, mDMyDate)
If miResult = 1 Then
lblDayStatus = LoGetDayStatus(mDMyDate)
Else
lblDayStatus = ""
End If
End Sub
Private Function LoGetDayStatus(ByVal DDate As Date) As String
Dim i As Integer
Dim sCode As String
'Const AT_NORMAL = 0 '正常上班
'Const AT_REST = 1 '礼拜天
'Const AT_FEAST = 2 '法定假
'Const AT_HOLIDAY = 3 '请假
'Const AT_WORKDAY = 4 '工作日
For i = 0 To UBound(mTRestDay)
If gclsInclude.MyGetFirstDay(DDate) = mTRestDay(i).DMonth Then
sCode = mTRestDay(i).sRestDay(Day(DDate) - 1)
Select Case sCode
Case AT_NORMAL
LoGetDayStatus = ""
Case AT_REST
LoGetDayStatus = "休息日"
Case AT_FEAST
LoGetDayStatus = "法定假日"
Case AT_WORKDAY
LoGetDayStatus = "工作日"
Case AT_HOLIDAY
LoGetDayStatus = LoGetHolidayDesc(sCode)
End Select
End If
Next i
End Function
Private Function LoGetHolidayDesc(ByVal fsCode As String) As String
Dim n As Integer
Dim i As Integer
n = mnuHoliday.Count - 1
For i = 0 To n
If fsCode = mnuHoliday(i).Tag Then
LoGetHolidayDesc = gclsCommon.CBNGetSecondData(mnuHoliday(i).Caption)
Exit Function
End If
Next i
End Function
Private Function LoIsSelect(DDate As Date) As Boolean
If MonthView1.SelStart = MonthView1.SelEnd Then
LoIsSelect = (MonthView1.SelStart = DDate)
Else
LoIsSelect = (DDate <= MonthView1.SelEnd And DDate >= MonthView1.SelStart)
End If
End Function
Private Sub LoAddNewWeek()
Dim i As Integer
Dim n As Integer
Dim iIndex As Integer
Dim bIsBold As Boolean
If mDCurrDay = 0 Then Exit Sub
iIndex = -1
n = UBound(mTRestDay)
Dim DDate As Date
For i = 0 To n
If mTRestDay(i).DMonth = gclsInclude.MyGetFirstDay(mDCurrDay) Or mTRestDay(i).DMonth = 0 Then
iIndex = i
Exit For
End If
Next i
If iIndex = -1 Then
ReDim Preserve mTRestDay(n + 1)
iIndex = n + 1
End If
mTRestDay(iIndex).DMonth = gclsInclude.MyGetFirstDay(mDCurrDay)
'iFirstDay =
For i = 0 To 6
mTRestDay(iIndex).iWeekState(i) = IIf(chkRestDay(i).Value = 1, 1, 0)
'将日历设置为节假日
For n = 0 To gclsInclude.MyGetDays(mDCurrDay) - 1
If mTRestDay(iIndex).sRestDay(n) <> 2 Then
MonthView1.DayBold(mTRestDay(iIndex).DMonth + n) = True
End If
Next n
Next i
End Sub
'节假日设置,星期日自动覆盖
'如:LoSetDayState("00-12-1",AT_FEAST,"5,6,7")
Private Sub LoSetDayState(fDDate As Date, _
ByVal fiType As Integer, _
ByVal fsIndex As String, _
Optional ByVal fsPlanCode As String)
Dim i As Integer
Dim n As Integer
Dim iIndex As Integer
Dim bIsBold As Boolean
Dim sSplit
If fDDate = 0 Then Exit Sub
iIndex = -1
n = UBound(mTRestDay)
Dim DDate As Date
For i = 0 To n
If mTRestDay(i).DMonth = gclsInclude.MyGetFirstDay(fDDate) Or mTRestDay(i).DMonth = 0 Then
If mTRestDay(i).iDataType = 1 Then
mTRestDay(i).iDataType = 2
ElseIf mTRestDay(i).iDataType = 0 Then
mTRestDay(i).iDataType = 3
End If
iIndex = i
Exit For
End If
Next i
If iIndex = -1 Then
ReDim Preserve mTRestDay(n + 1)
iIndex = n + 1
mTRestDay(iIndex).iDataType = 3
End If
sSplit = Split(fsIndex, ",")
mTRestDay(iIndex).DMonth = fDDate
If mTRestDay(i).iDataType < 2 Then
mTRestDay(i).iDataType = 2
End If
mbDateChange = True
If Not cmdSave.Enabled Then cmdSave.Enabled = True
For i = 0 To UBound(sSplit)
If fiType = AT_HOLIDAY Then
mTRestDay(iIndex).sRestDay(sSplit(i)) = fsPlanCode
Else
mTRestDay(iIndex).sRestDay(sSplit(i)) = fiType
End If
Next i
' If fiType = AT_REST Then
For i = 0 To 6
mTRestDay(iIndex).iWeekState(i) = chkRestDay(i).Value
Next i
' End If
LoSetDayBold mTRestDay(iIndex)
End Sub
Private Sub LoSetDayBold(fRestDay As RestDay)
Dim i As Integer
Dim iDays As Integer
iDays = gclsInclude.MyGetDays(fRestDay.DMonth) - 1
For i = 0 To iDays
If fRestDay.sRestDay(i) = "" Then fRestDay.sRestDay(i) = "0"
MonthView1.DayBold(fRestDay.DMonth + i) = (fRestDay.sRestDay(i) <> "0")
Next i
End Sub
Private Sub LoAddHolidayMenu()
Dim adoTempRS As ADODB.Recordset
Dim i As Integer
Set adoTempRS = New ADODB.Recordset
adoTempRS.Open "SELECT * FROM T0118S001", gDBRecordConn, adOpenStatic, adLockReadOnly
With adoTempRS
If .RecordCount > 0 Then mnuHoli.Visible = True
For i = 1 To .RecordCount
LoSetMenuData mnuHoliday, i - 1, !W6671 & SPLIT_SYMBOL & !W6676, !W6672
.MoveNext
Next i
End With
End Sub
Private Sub LoSetMenuData(fmnuItem, _
ByVal fiIndex As Integer, _
ByVal fsCaption As String, _
ByVal fsPlanCode As String)
Dim i As Integer
Dim bHaveDescript As Boolean
If fmnuItem(0).Tag = "" Then
i = 0
Else
i = fmnuItem.Count
Load fmnuItem(i)
End If
fmnuItem(i).Caption = fsCaption
fmnuItem(i).Tag = fsPlanCode
fmnuItem(i).Visible = True
End Sub
Private Sub LoSetButtonTag()
cmdSave.Tag = "IMG041"
cmdExit.Tag = "IMG029"
cmdOK.Tag = "IMG038"
End Sub