📄 frmacount.frm
字号:
Begin Threed.SSPanel lbStatus
Height = 630
Left = 7995
TabIndex = 5
Top = 150
Width = 2160
_Version = 65536
_ExtentX = 3810
_ExtentY = 1111
_StockProps = 15
Caption = "全球通商务管理系统"
ForeColor = 255
BackColor = 12632256
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "Fixedsys"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
BorderWidth = 1
BevelOuter = 0
RoundedCorners = 0 'False
FloodColor = 16776960
FloodShowPct = 0 'False
Alignment = 0
Autosize = 1
Begin VB.Label lbDate
AutoSize = -1 'True
Caption = "00:00:00"
ForeColor = &H00404040&
Height = 180
Left = 1020
TabIndex = 6
Top = 330
Width = 720
End
Begin VB.Label Label4
Caption = "现在时间："
ForeColor = &H00404040&
Height = 240
Left = 120
TabIndex = 7
Top = 345
Width = 975
End
End
End
Begin MSComctlLib.ImageList ImageList1
Left = 0
Top = 0
_ExtentX = 1005
_ExtentY = 1005
BackColor = -2147483643
ImageWidth = 32
ImageHeight = 32
MaskColor = 12632256
_Version = 393216
BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628}
NumListImages = 11
BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmAcount.frx":4A24
Key = ""
EndProperty
BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmAcount.frx":4D40
Key = ""
EndProperty
BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmAcount.frx":505C
Key = ""
EndProperty
BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmAcount.frx":5378
Key = ""
EndProperty
BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmAcount.frx":5694
Key = ""
EndProperty
BeginProperty ListImage6 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmAcount.frx":59B0
Key = ""
EndProperty
BeginProperty ListImage7 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmAcount.frx":628C
Key = ""
EndProperty
BeginProperty ListImage8 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmAcount.frx":65A8
Key = ""
EndProperty
BeginProperty ListImage9 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmAcount.frx":68C4
Key = ""
EndProperty
BeginProperty ListImage10 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmAcount.frx":6BE0
Key = ""
EndProperty
BeginProperty ListImage11 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmAcount.frx":74BC
Key = ""
EndProperty
EndProperty
End
Begin VB.Menu mnuChart
Caption = "控制菜单"
Visible = 0 'False
Begin VB.Menu mnu2d
Caption = "二维显示"
Begin VB.Menu mnuLine
Caption = "线型显示(&L)..."
Shortcut = ^L
End
Begin VB.Menu mnuBN
Caption = "饼图显示(&B)..."
Shortcut = ^B
End
Begin VB.Menu mnuZH
Caption = "组合显示(&Z)..."
Shortcut = ^Z
End
Begin VB.Menu mnuSD
Caption = "散点显示(&S)..."
Shortcut = ^S
End
End
Begin VB.Menu mnu3D
Caption = "三维显示"
Begin VB.Menu mnuT
Caption = "条型显示(&T)..."
Shortcut = ^T
End
Begin VB.Menu mnuH
Caption = "行型显示(&H)..."
Shortcut = ^H
End
Begin VB.Menu mnuCM
Caption = "组合显示(&M)..."
Shortcut = ^M
End
End
Begin VB.Menu mnuCopy
Caption = "拷贝到剪切板(&C)..."
Shortcut = ^C
End
End
End
Attribute VB_Name = "frmAcount"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim New_AniCur As New AniCursor
Dim New_AniCur1 As New AniCursor '动画光标
Private Const MARGIN_SIZE = 60 'In Twips
Private Const SHAPE_COMMAND = "SHAPE {select GoodsID,GoodsName,SumQua,Date from SellDetail Order by SumQua} AS ChildCommand COMPUTE ChildCommand, AVG(ChildCommand.[SumQua]) AS [SumQua] BY [GoodsID], [Date]"
Private Const CONNECT_STRING = "PROVIDER=MSDataShape;dsn=YSL_POS;uid=;pwd=;Data Provider=MSDASQL"
Private Const FIELD_X = "GoodsName"
Private Const FIELD_Y = "SumQua1"
Private Const FIELD_Z = "sDate"
Private Const VBERR_INVALID_PROCEDURE_CALL = 5
Private Const MARKERS_VISIBLE = -1
Private Const BRACKET_LEFT = "["
Private Const BRACKET_RIGHT = "]"
Private Const SPACE_CHAR = " "
Dim bCount As Boolean
Private Sub chtReport_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = 2 Then
'右键时
PopupMenu mnuChart
End If
End Sub
Private Sub cmdCashReturn_Click()
tbOrder.Buttons(1).Enabled = True
tbOrder.Buttons(2).Enabled = True
tbOrder.Buttons(4).Enabled = True
MovePic picCash, False, frmAcount, Grid1, Grid2
End Sub
Private Sub cmdCashSearch_Click()
If Trim(txtCashName.Text) = "" Then
ConfigAcount "Select * From Account Where Date>=#" & dpCStart.Value & "# And Date<=#" & dpCEnd.Value & "# Order By ID"
Else
ConfigAcount "Select * From Account Where Date>=#" & dpCStart.Value & "# And Date<=#" & dpCEnd.Value & "# And (UnitID Like '*" & Trim(txtCashName.Text) & "*' or UnitName Like '*" & Trim(txtCashName.Text) & "*') Order By ID"
End If
End Sub
Private Sub cmdDisplayorder_Click()
ConfigOrder "Select * From SellSheet Order By ID"
End Sub
Private Sub cmdReturn_Click()
tbOrder.Buttons(1).Enabled = True
tbOrder.Buttons(2).Enabled = True
tbOrder.Buttons(4).Enabled = True
MovePic picBrowser, False, frmAcount, Grid1, Grid4
End Sub
Private Sub cmdSearchOrder_Click()
Dim sSQL As String
If optStatus(0).Value = True Then
sSQL = " And IsAcc=0 And ISEnd=0 Order By ID"
End If
If optStatus(1).Value = True Then
sSQL = " And IsAcc=1 And ISEnd=0 Order By ID"
End If
If optStatus(2).Value = True Then
sSQL = " And IsAcc=1 And ISEnd=1 Order By ID"
End If
If optStatus(3).Value = True Then
sSQL = " Order By ID"
End If
If Trim(txtSupplerName.Text) = "" Then
ConfigOrder "Select * From SellSheet Where Date>=#" & dtStartDate.Value & "# And Date<=#" & dtEndDate.Value & "#" & sSQL
Else
ConfigOrder "Select * From SellSheet Where Date>=#" & dtStartDate.Value & "# And Date<=#" & dtEndDate.Value & "# And UnitName Like '*" & Trim(txtSupplerName.Text) & "*'" & sSQL
End If
End Sub
Private Sub Command3_Click()
tbOrder.Buttons(1).Enabled = True
tbOrder.Buttons(2).Enabled = True
tbOrder.Buttons(4).Enabled = True
MovePic picSelectP, False, frmAcount, Grid1, Grid3
End Sub
Private Sub Command4_Click()
Dim sSQL As String
sSQL = " GROUP BY GoodsID, GoodsName"
If Trim(txtProduct.Text) = "" Then
'ConfigProduct "Select GoodsID,GoodsName,Date,Sum(Qua1) as Q1,Sum(Qua2) as Q2,Sum(Qua3) as Q3,Sum(Qua4) as Q4,Sum(Qua5) as Q5,Sum(Qua6) as Q6,Sum(Qua7) as Q7,Sum(Qua8) as Q8,Sum(Qua9) as Q9,Sum(SumQua) as SumQua1,Sum(Amo) as Amo1 From SellDetail Where Date>=#" & dpAStart.Value & "# And Date<=#" & dpAEnd.Value & "#" & sSQL
MarkCount "INSERT into SellCount SELECT GoodsID AS GoodsID, GoodsName AS GoodsName, Sum(Qua1) AS Q1, Sum(Qua2) AS Q2, Sum(Qua3) AS Q3, Sum(Qua4) AS Q4, Sum(Qua5) AS Q5, Sum(Qua6) AS Q6, Sum(Qua7) AS Q7, Sum(Qua8) AS Q8, Sum(Qua9) AS Q9, Sum(SumQua) AS SumQua1, Sum(Amo) AS Amo1 From SellDetail Where Date>=#" & dpAStart.Value & "# And Date<=#" & dpAEnd.Value & "#" & sSQL, dpAStart.Value & "至" & dpAEnd.Value
Else
'ConfigProduct "Select GoodsID,GoodsName,Date,Sum(Qua1) as Q1,Sum(Qua2) as Q2,Sum(Qua3) as Q3,Sum(Qua4) as Q4,Sum(Qua5) as Q5,Sum(Qua6) as Q6,Sum(Qua7) as Q7,Sum(Qua8) as Q8,Sum(Qua9) as Q9,Sum(SumQua) as SumQua1,Sum(Amo) as Amo1 From SellDetail Where Date>=#" & dpAStart.Value & "# And Date<=#" & dpAEnd.Value & "# And GoodsName Like '*" & Trim(txtProduct.Text) & "*' or GoodsID Like '*" & Trim(txtProduct.Text) & "*' " & sSQL
MarkCount "INSERT into SellCount SELECT GoodsID AS GoodsID, GoodsName AS GoodsName, Sum(Qua1) AS Q1, Sum(Qua2) AS Q2, Sum(Qua3) AS Q3, Sum(Qua4) AS Q4, Sum(Qua5) AS Q5, Sum(Qua6) AS Q6, Sum(Qua7) AS Q7, Sum(Qua8) AS Q8, Sum(Qua9) AS Q9, Sum(SumQua) AS SumQua1, Sum(Amo) AS Amo1 From SellDetail Where Date>=#" & dpAStart.Value & "# And Date<=#" & dpAEnd.Value & "# And GoodsName Like '*" & Trim(txtProduct.Text) & "*' or GoodsID Like '*" & Trim(txtProduct.Text) & "*' " & sSQL, dpAStart.Value & "至" & dpAEnd.Value
End If
bCount = True
ConfigProduct "Select * From SellCount order by SumQua1 desc"
If chtReport.Visible = True Then
MarkChart
End If
End Sub
Private Sub Command5_Click()
If Command5.Caption = "图型(&T)" Then
If bCount = True Then
MarkChart
End If
chtReport.Visible = True
Grid3.Visible = False
Command5.Caption = "表格(&T)"
Else
Grid3.Visible = True
chtReport.Visible = False
Command5.Caption = "图型(&T)"
End If
End Sub
Private Sub dpAEnd_Change()
If dpAStart.Value > dpAEnd Then
dpAStart.Value = dpAEnd.Value
End If
End Sub
Private Sub dpAStart_Change()
If dpAStart.Value > dpAEnd.Value Then
dpAEnd.Value = dpAStart.Value
End If
End Sub
Private Sub dpCEnd_Change()
If dpCStart.Value > dpCEnd.Value Then
dpCStart.Value = dpCEnd.Value
End If
End Sub
Private Sub dpCStart_Change()
If dpCStart.Value > dpCEnd.Value Then
dpCEnd.Value = dpCStart.Value
End If
End Sub
Private Sub dtEndDate_Change()
If dtStartDate.Value > dtEndDate Then
dtStartDate.Value = dtEndDate.Value
End If
End Sub
Private Sub dtStartDate_Change()
If dtStartDate.Value > dtEndDate Then
dtEndDate.Value = dtStartDate.Value
End If
End Sub
Private Sub Form_Load()
Screen.MousePointer = 11
'安装项目
StartLoad
'配置网格
ConfigData
bCount = True
New_AniCur.AniFileName = App.Path & "\sys\2.ani"
New_AniCur.SetAniCursor tbOrder.hwnd
Screen.MousePointer = 0
FormID = "Count100"
End Sub
Private Sub Form_Resize()
If Me.WindowState = 1 Then Exit Sub
On Error Resume Next
lbStatus.left = Me.Width - lbStatus.Width - 300
lbStatus.tOp = 150
picOperator.left = 20
picOperator.tOp = tbOrder.Height + 40
picOperator.Width = Me.ScaleWidth - 40
picOperator.Height = Me.ScaleHeight - tbOrder.Height - 60
With picBrowser
.Width = Me.ScaleWidth
.left = 0 - .Width
.tOp = tbOrder.Height + 40
.Height = Me.ScaleHeight - tbOrder.Height - 40
End With
With picSelectP
.Width = Me.ScaleWidth
.left = 0 - .Width
.tOp = tbOrder.Height + 40
.Height = Me.ScaleHeight - tbOrder.Height - 40
End With
With picCash
.Width = Me.ScaleWidth
.left = 0 - .Width
.tOp = tbOrder.Height + 40
.Height = Me.ScaleHeight - tbOrder.Height - 40
End With
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -