📄 frmcalcscript.frm
字号:
VERSION 5.00
Object = "{F6125AB1-8AB1-11CE-A77F-08002B2F4E98}#2.0#0"; "MSRDC20.OCX"
Begin VB.Form frmCalcScript
Caption = "计算底稿"
ClientHeight = 2085
ClientLeft = 60
ClientTop = 345
ClientWidth = 5160
KeyPreview = -1 'True
LinkTopic = "Form2"
MDIChild = -1 'True
ScaleHeight = 2085
ScaleWidth = 5160
Begin VB.ComboBox cboPeriod
Height = 300
Left = 1845
Style = 2 'Dropdown List
TabIndex = 4
Top = 45
Width = 1305
End
Begin MSRDC.MSRDC datItem
Height = 375
Left = 2520
Top = 960
Visible = 0 'False
Width = 1200
_ExtentX = 2117
_ExtentY = 661
_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 txtMethod
Alignment = 2 'Center
BackColor = &H80000004&
Height = 285
Left = 3195
Locked = -1 'True
TabIndex = 3
Text = "计算方法：移动平均"
Top = 45
Width = 1725
End
Begin VB.CommandButton cmdPrint
Height = 350
Left = 90
Style = 1 'Graphical
TabIndex = 2
Tag = "1012"
Top = 1680
UseMaskColor = -1 'True
Width = 1215
End
Begin VB.PictureBox picGrid
Height = 975
Left = 90
ScaleHeight = 915
ScaleWidth = 1785
TabIndex = 1
Top = 510
Width = 1845
End
Begin VB.Label lblPeriod
AutoSize = -1 'True
Caption = "会计期间"
Height = 180
Left = 1065
TabIndex = 5
Top = 105
Width = 720
End
Begin VB.Label lblItem
AutoSize = -1 'True
Caption = "商品"
Height = 180
Left = 75
TabIndex = 0
Top = 105
Width = 360
End
End
Attribute VB_Name = "frmCalcScript"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 成本计算底稿
' 作者：唐维勇
' 日期：1998.7.17
'
' 对于移动平均、先进先出、后进先出、批次法可查看成本计算底稿
' 移动平均：
' 底稿根据商品期初和本期商品明细生成。
' 生成查询：QItemMoveScript
' 先进先出、后进先出、批次法
' 底稿根据商品成本批次生成
' 生成查询：QItemFIFOScript
' 生成查询：QItemLIFOScript
' 生成查询：QItemSingleScript
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit
Private WithEvents mclsMainControl As MainControl '主控对象
Attribute mclsMainControl.VB_VarHelpID = -1
Private WithEvents mclsGrid As TableGrid 'Grid对象
Attribute mclsGrid.VB_VarHelpID = -1
Private WithEvents mclsSubClassform As SubClass32.SubClass
Attribute mclsSubClassform.VB_VarHelpID = -1
Private Const mViewID = 89 '视图号
Private Const HelpID = 13005
Private Const mlngFormMinWidth = 500 '窗体最小尺寸
Private Const mlngFormMinHeight = 300
Private Const mlngLeft = 50
Private Const mlngTop = 420
Private Const mlngBottomHeight = 75
Private mstrMethodCode As String '计算方法代码
Private mlngItemID As Long '指定商品
Private mintYear As Integer
Private mbytPeriod As Integer
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
' 外部方法
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'设置查询商品、成本方法、开始日期、结束日期
Public Sub SetParameters(ByVal lngItemID As Long, ByVal strItemName As String, _
ByVal intYear As Integer, ByVal bytPeriod As Integer, ByVal strMethodCode As String, ByVal strDate As String)
Me.Hide
mintYear = intYear
mbytPeriod = bytPeriod
mlngItemID = lngItemID
lblItem.Caption = strItemName
txtMethod.Text = MethodName(strMethodCode)
InitPeriod
RefreshGrid
Me.Show
Refresh
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
' 私有方法
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'生成计算底稿结果集
Private Function GetList() As rdoResultset
Dim recResultset As rdoResultset
Dim strSql As String
Dim errNo As Long
Dim dtmStart As Date
On Error GoTo errHandle
strSql = "SELECT 0 As ID," & mclsGrid.ListSet.SelectOfSql _
& " " & mclsGrid.ListSet.FromOfSql _
& " WHERE " & mclsGrid.ListSet.WhereOfSql _
& " AND CostScript.lngItemID=" & mlngItemID _
& " AND CostScript.intYear=" & gclsBase.AccountYear _
& " AND CostScript.bytPeriod=" & mbytPeriod & " ORDER BY lngOrderID"
If txtMethod.Text = "移动平均" Then
gclsBase.DateOfPeriod mintYear, mbytPeriod, dtmStart
strSql = Replace(strSql, "[BEGINDATE]", Format(dtmStart, "yyyy-mm-dd"))
End If
Set GetList = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
Exit Function
errHandle:
errNo = Errors.ErrorsDeal(True, Me)
Select Case errNo
Case edtResume: Resume
Case edtResumeNext: Resume Next
Case edtCanNotKnown
ShowMsg hWnd, "程序出错：" & Err.Description, vbOKOnly + vbCritical, Caption
End Select
Set GetList = Nothing
End Function
Private Sub InitPeriod()
Dim strSql As String
Dim recPeriod As rdoResultset
cboPeriod.Clear
strSql = "SELECT intYear,bytPeriod FROM AccountPeriod " _
& "WHERE strStartDate>='" & Format(gclsBase.BeginDate, "yyyy-mm-dd") & "' " _
& "ORDER BY 1,2"
Set recPeriod = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
Do While Not recPeriod.EOF
cboPeriod.AddItem recPeriod!intYear & "年" & Format(recPeriod!bytPeriod, "00") & "期"
If recPeriod!intYear = mintYear And recPeriod!bytPeriod = mbytPeriod Then
cboPeriod.ListIndex = cboPeriod.ListCount - 1
End If
recPeriod.MoveNext
Loop
recPeriod.Close
Set recPeriod = Nothing
End Sub
Private Sub cboPeriod_Click()
If C2lng(Left(cboPeriod.Text, 4)) <> mintYear Or C2lng(Mid(cboPeriod.Text, 6, 2)) <> mbytPeriod Then
mintYear = C2lng(Left(cboPeriod.Text, 4))
mbytPeriod = C2lng(Mid(cboPeriod.Text, 6, 2))
RefreshGrid
End If
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
' 控件 事件、方法
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub CmdPrint_Click()
mclsMainControl_FilePrint
End Sub
Private Sub Form_Activate()
SetHelpID HelpContextID
gclsSys.CurrFormName = hWnd
mclsMainControl_ChildActive
End Sub
Private Sub Form_Deactivate()
frmMain.SetEditUnEnabled
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 27 Then
Unload Me
End If
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
' Form 事件、方法
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub Form_Load()
Me.MousePointer = vbHourglass
Me.HelpContextID = HelpID
'设置Grid
With picGrid
.Visible = True
.Left = mlngLeft
.top = mlngTop
End With
Set mclsSubClassform = New SubClass32.SubClass
mclsSubClassform.hWnd = Me.hWnd
mclsSubClassform.Messages(WM_GETMINMAXINFO) = True
'主控对象
Set mclsMainControl = gclsSys.MainControls.Add(Me)
'Grid对象
Set mclsGrid = New TableGrid
mclsGrid.ListSet.ViewId = mViewID
Me.MousePointer = vbDefault
End Sub
Private Sub Form_Unload(Cancel As Integer)
On Error Resume Next
'保存Grid设置
Set mclsSubClassform = Nothing
Set mclsGrid = Nothing
Set mclsSubClassform = Nothing
gclsSys.MainControls.Remove Me
Set mclsMainControl = Nothing
End Sub
Private Sub Form_Resize()
On Error Resume Next
If WindowState <> vbMinimized Then
If WindowState <> vbMaximized And (Left >= Screen.width Or Left + width <= 0) Then
Left = (Screen.width - width) / 2
End If
txtMethod.Left = ScaleWidth - txtMethod.width - ListFormRight
cboPeriod.Left = txtMethod.Left - cboPeriod.width - 60
lblPeriod.Left = cboPeriod.Left - lblPeriod.width - 60
With picGrid
.Left = ListFormLeft
.width = ScaleWidth - 2 * mlngLeft
.Height = ScaleHeight - 2 * mlngBottomHeight - mlngTop - cmdPrint.Height
End With
cmdPrint.Left = ListFormLeft
cmdPrint.top = ScaleHeight - cmdPrint.Height - ListFormBottom
End If
End Sub
Private Sub mclsMainControl_FilePrint()
Dim myPrintclass As PrintClass
mclsGrid.ClearSortColArrow
Set myPrintclass = New PrintClass
myPrintclass.PrintNewList gclsBase.BaseDB, mclsGrid.Resultset, mclsGrid.Grid.TableHandle, 72, Me.Caption & Chr(1) & gclsBase.BaseName & Chr(1) & gclsBase.OperatorName
Set myPrintclass = Nothing
mclsGrid.AddSortColArrow
End Sub
Private Sub mclsMainControl_FilePrintSetup()
Dim clsPrintclass As PrintClass
Set clsPrintclass = New PrintClass
clsPrintclass.PrintNewSetUp gclsBase.BaseDB, mclsGrid.Grid.TableHandle, , , , 72, Me.Caption & Chr(1) & gclsBase.BaseName & Chr(1) & gclsBase.OperatorName
Set clsPrintclass = Nothing
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 = mlngFormMinWidth
MinMax.ptMinTrackSize.y = mlngFormMinHeight
CopyMemory ByVal lParam, MinMax, Len(MinMax)
Result = 0
End If
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
' 主控事件
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub mclsMainControl_ChildActive()
UpdateMenuStatu
End Sub
Private Sub UpdateMenuStatu()
With frmMain
.mnuEditCopy.Enabled = False
.mnuEditEdit.Enabled = False
.mnuEditNew.Enabled = False
.mnuEditDel.Enabled = False
.mnuEditInActive.Enabled = False
.mnuEditShowAll.Checked = False
.mnuEditShowAll.Enabled = False
.mnuEditUse.Enabled = False
.mnuEditColumn.Enabled = False
.mnuEditFilter.Enabled = False
.mnuEditSearch.Enabled = False
.mnuEditNotepad.Enabled = False
.mnuEditShowList.Enabled = False
.mnuEditUse.Enabled = False
.mnuFilePrintSetup.Enabled = True
.mnuFilePrint.Enabled = True
.mnuToolRefresh.Enabled = False
.SetToolBar
End With
End Sub
'************************************************************************************
'*
'* TableGrid 借口
'*
'************************************************************************************
Private Sub mclsGrid_RefreshRecord(blnSucceed As Boolean)
Set mclsGrid.Resultset = GetList(mstrMethodCode)
blnSucceed = True
End Sub
Private Sub RefreshGrid()
If Trim(txtMethod.Text) = "移动平均" Then
mclsGrid.SetFormatPara 10, 4, "-", 7, -1
mclsGrid.SetFormatPara 12, 6, "-", 9, -1
mclsGrid.SetFormatPara 11, 12, "/", 10, , gclsBase.PriceDec
End If
mclsGrid.ColOfs = 1
Set mclsGrid.Resultset = GetList()
mclsGrid.hWnd = picGrid.hWnd
mclsGrid.RefreshGrid
End Sub
Private Sub mclsGrid_AfterRefreshGrid()
If Trim(txtMethod.Text) <> "移动平均" Then
mclsGrid.Grid.ColWidth(10) = 0
mclsGrid.Grid.ColWidth(11) = 0
mclsGrid.Grid.ColWidth(12) = 0
Else
If mclsGrid.Grid.ColWidth(10) = 0 Then
mclsGrid.Grid.ColWidth(10) = mclsGrid.Grid.ColWidth(7)
End If
If mclsGrid.Grid.ColWidth(11) = 0 Then
mclsGrid.Grid.ColWidth(11) = mclsGrid.Grid.ColWidth(8)
End If
If mclsGrid.Grid.ColWidth(12) = 0 Then
mclsGrid.Grid.ColWidth(12) = mclsGrid.Grid.ColWidth(9)
End If
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -