📄 frmphhtongmx.frm
字号:
VERSION 5.00
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "MSFLXGRD.OCX"
Begin VB.Form frmPHHTongMX
BorderStyle = 0 'None
Caption = "合同明细查询"
ClientHeight = 6735
ClientLeft = 0
ClientTop = 0
ClientWidth = 10185
LinkTopic = "Form1"
Picture = "frmPHHTongMX.frx":0000
ScaleHeight = 6735
ScaleWidth = 10185
StartUpPosition = 2 '屏幕中心
Begin VB.PictureBox Picture7
AutoSize = -1 'True
BorderStyle = 0 'None
Height = 450
Left = 6960
Picture = "frmPHHTongMX.frx":E51E2
ScaleHeight = 450
ScaleWidth = 1020
TabIndex = 5
Top = 840
Width = 1020
End
Begin VB.PictureBox Picture5
AutoSize = -1 'True
BorderStyle = 0 'None
Height = 450
Left = 4320
Picture = "frmPHHTongMX.frx":E6A0C
ScaleHeight = 450
ScaleWidth = 1020
TabIndex = 4
Top = 840
Width = 1020
End
Begin VB.PictureBox Picture6
AutoSize = -1 'True
BorderStyle = 0 'None
Height = 465
Left = 5670
Picture = "frmPHHTongMX.frx":E8236
ScaleHeight = 465
ScaleWidth = 1020
TabIndex = 3
Top = 840
Width = 1020
End
Begin VB.TextBox Text1
Appearance = 0 'Flat
Height = 270
Left = 2100
TabIndex = 2
Top = 930
Width = 1365
End
Begin MSFlexGridLib.MSFlexGrid MSFlex1
Height = 4605
Left = 570
TabIndex = 6
Top = 1590
Width = 9225
_ExtentX = 16272
_ExtentY = 8123
_Version = 393216
FixedCols = 0
AllowUserResizing= 1
Appearance = 0
End
Begin VB.Label Label2
BackStyle = 0 'Transparent
Caption = "输入合同号"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Index = 4
Left = 990
TabIndex = 1
Top = 960
Width = 1185
End
Begin VB.Image Image2
Height = 375
Left = 9210
Picture = "frmPHHTongMX.frx":E9B2C
Top = 210
Width = 390
End
Begin VB.Image Image1
Height = 330
Left = 9630
Picture = "frmPHHTongMX.frx":EA33E
Top = 210
Width = 330
End
Begin VB.Label Label1
BackStyle = 0 'Transparent
Caption = "合同明细查询"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H0000FFFF&
Height = 225
Left = 930
TabIndex = 0
Top = 300
Width = 1635
End
End
Attribute VB_Name = "frmPHHTongMX"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim n As Integer
Dim jframe As New dframe
Dim env As rdoEnvironment
Dim cn As rdoConnection
Dim result As rdoResultset
Dim sql As String
Dim d_conn As String
Dim i As Integer
Dim HJ(10) As Single
Private Sub Form_Load()
rgn1 = 0
n = 0
Dim Ma As Dat
Show
Open App.Path & "\base.dat" For Random As #1 Len = Len(Ma)
Do While Not EOF(1)
n = n + 1
Get #1, n, Ma
If rgn1 = 0 Then rgn1 = CreateRectRgn(Ma.sx, Ma.sy, Ma.ex, Ma.ey)
If rgn1 <> 0 Then
rgn2 = CreateRectRgn(Ma.sx, Ma.sy, Ma.ex, Ma.ey)
CombineRgn rgn1, rgn1, rgn2, 2
'释放系统资源
DeleteObject rgn2
End If
Loop
'关闭文件
Close #1
SetWindowRgn hwnd, rgn1, True
DeleteObject rgn1
''''''''''连接远程数据库SQL server''''
''''''''''连接远程数据库SQL SERVER''''
On Error GoTo errmsg
' Set env = rdoEnvironments(0)
' env.CursorDriver = rdUseOdbc
' d_conn = "uid=sa;pwd=;driver={SQL SERVER};SERVER=ntserver;database=phdatabase;"
' Set cn = env.OpenConnection(dsname:="odbc_api_demo", Prompt:="rdodriverprompt", ReadOnly:=False, Connect:=d_conn)
'''''''
MSFlex1.BackColorBkg = RGB(255, 255, 255)
MSFlex1.BackColorFixed = RGB(238, 236, 218)
MSFlex1.FormatString = "^ 日 期 |^ 客户名称 |^ 总面积 |^ 应收款额 |^ 已收款额 |^ 未收款额 |^ 业务员 |^ 签单人 "
errmsg:
' Dim er As rdoError
' For Each er In rdoErrors
' MsgBox "号码:" & er.Number & ":" & er.Source & "..." & er.Description
' Next er
If Err.Number <> 0 Then
'MsgBox "错误号:" & Err.Number & " " & Err.Source & "和" & Err.Description, vbExclamation
End If
Exit Sub
End Sub
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then
mX = X
mY = Y
End If
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then
frmPHHTongMX.Move frmPHHTongMX.Left - mX + X, frmPHHTongMX.Top - mY + Y
End If
Picture5.Cls
Picture6.Cls
Picture7.Cls
End Sub
Private Sub Form_Paint()
'''''商品编号'''
jframe.danum = 3
jframe.rtop = 50
jframe.rleft = 35
jframe.rright = 659
jframe.rbottom = 97
jframe.ddraw frmPHHTongMX
''''''''
jframe.danum = 3
jframe.rtop = 102
jframe.rleft = 35
jframe.rright = 659
jframe.rbottom = 420
jframe.ddraw frmPHHTongMX
End Sub
Private Sub Image1_Click()
Unload Me
End Sub
Private Sub Image2_Click()
frmPHHTongMX.WindowState = 1
End Sub
Private Sub Picture5_Click()
On Error GoTo errmsg
If Text1.Text <> "" Then
sql = "select * from YWPRtable where 合同号='" & Trim(Text1.Text) & "'"
Set result = cn.OpenResultset(sql, rdOpenDynamic, rdConcurRowVer)
If result.RowCount <> 0 Then
result.MoveLast
MSFlex1.Rows = result.RowCount + 2
result.MoveFirst
End If
If result.RowCount <> 0 Then
i = 1
Do While Not result.EOF()
MSFlex1.TextArray(i * MSFlex1.Cols) = Trim(result("日期"))
MSFlex1.TextArray(i * MSFlex1.Cols + 1) = Trim(result("客户名称"))
MSFlex1.TextArray(i * MSFlex1.Cols + 2) = Trim(result("总面积"))
MSFlex1.TextArray(i * MSFlex1.Cols + 3) = Trim(result("应收款额"))
MSFlex1.TextArray(i * MSFlex1.Cols + 4) = Trim(result("已收款额"))
MSFlex1.TextArray(i * MSFlex1.Cols + 5) = Trim(result("未收款额"))
MSFlex1.TextArray(i * MSFlex1.Cols + 6) = Trim(result("业务员"))
MSFlex1.TextArray(i * MSFlex1.Cols + 7) = Trim(result("签单人"))
result.MoveNext
i = i + 1
Loop
End If
''''计算合计'''''''
For i = 0 To 9
HJ(i) = 0
Next i
For i = 1 To MSFlex1.Rows - 2
HJ(0) = HJ(0) + Val(MSFlex1.TextArray(i * MSFlex1.Cols + 2))
HJ(1) = HJ(1) + Val(MSFlex1.TextArray(i * MSFlex1.Cols + 3))
HJ(2) = HJ(2) + Val(MSFlex1.TextArray(i * MSFlex1.Cols + 4))
HJ(3) = HJ(3) + Val(MSFlex1.TextArray(i * MSFlex1.Cols + 5))
Next i
MSFlex1.TextArray((MSFlex1.Rows - 1) * MSFlex1.Cols) = "合计:"
MSFlex1.TextArray((MSFlex1.Rows - 1) * MSFlex1.Cols + 2) = HJ(0)
MSFlex1.TextArray((MSFlex1.Rows - 1) * MSFlex1.Cols + 3) = HJ(1)
MSFlex1.TextArray((MSFlex1.Rows - 1) * MSFlex1.Cols + 4) = HJ(2)
MSFlex1.TextArray((MSFlex1.Rows - 1) * MSFlex1.Cols + 5) = HJ(3)
End If
errmsg:
Dim er As rdoError
If Err.Number <> 0 Then
MsgBox "错误号:" & Err.Number & " " & Err.Source & "和" & Err.Description, vbExclamation
MSFlex1.Rows = 4
i = 1
MSFlex1.TextArray(i * MSFlex1.Cols) = "2002年03月10日" 'Trim(result("日期"))
MSFlex1.TextArray(i * MSFlex1.Cols + 1) = "抚顺天湖啤酒公司" 'Trim(result("客户名称"))
MSFlex1.TextArray(i * MSFlex1.Cols + 2) = "57" 'Trim(result("总面积"))
MSFlex1.TextArray(i * MSFlex1.Cols + 3) = "114" 'Trim(result("应收款额"))
MSFlex1.TextArray(i * MSFlex1.Cols + 4) = "114" 'Trim(result("已收款额"))
MSFlex1.TextArray(i * MSFlex1.Cols + 5) = "0" 'Trim(result("未收款额"))
MSFlex1.TextArray(i * MSFlex1.Cols + 6) = "张明" 'Trim(result("业务员"))
MSFlex1.TextArray(i * MSFlex1.Cols + 7) = "张明" 'Trim(result("签单人"))
i = 2
MSFlex1.TextArray(i * MSFlex1.Cols) = "2002年03月11日" 'Trim(result("日期"))
MSFlex1.TextArray(i * MSFlex1.Cols + 1) = "抚顺天湖啤酒公司" 'Trim(result("客户名称"))
MSFlex1.TextArray(i * MSFlex1.Cols + 2) = "42" 'Trim(result("总面积"))
MSFlex1.TextArray(i * MSFlex1.Cols + 3) = "126" 'Trim(result("应收款额"))
MSFlex1.TextArray(i * MSFlex1.Cols + 4) = "120" 'Trim(result("已收款额"))
MSFlex1.TextArray(i * MSFlex1.Cols + 5) = "6" 'Trim(result("未收款额"))
MSFlex1.TextArray(i * MSFlex1.Cols + 6) = "李辉" 'Trim(result("业务员"))
MSFlex1.TextArray(i * MSFlex1.Cols + 7) = "李明" 'Trim(result("签单人"))
'''计算合计
For i = 0 To 9
HJ(i) = 0
Next i
For i = 1 To MSFlex1.Rows - 2
HJ(0) = HJ(0) + Val(MSFlex1.TextArray(i * MSFlex1.Cols + 2))
HJ(1) = HJ(1) + Val(MSFlex1.TextArray(i * MSFlex1.Cols + 3))
HJ(2) = HJ(2) + Val(MSFlex1.TextArray(i * MSFlex1.Cols + 4))
HJ(3) = HJ(3) + Val(MSFlex1.TextArray(i * MSFlex1.Cols + 5))
Next i
MSFlex1.TextArray((MSFlex1.Rows - 1) * MSFlex1.Cols) = "合计:"
MSFlex1.TextArray((MSFlex1.Rows - 1) * MSFlex1.Cols + 2) = HJ(0)
MSFlex1.TextArray((MSFlex1.Rows - 1) * MSFlex1.Cols + 3) = HJ(1)
MSFlex1.TextArray((MSFlex1.Rows - 1) * MSFlex1.Cols + 4) = HJ(2)
MSFlex1.TextArray((MSFlex1.Rows - 1) * MSFlex1.Cols + 5) = HJ(3)
End If
Exit Sub
End Sub
Private Sub Picture5_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Picture6.Cls
Picture7.Cls
jframe.danum = 5
jframe.rtop = 1
jframe.rleft = 1
jframe.rright = 65
jframe.rbottom = 29
jframe.ddrawc Picture5
End Sub
Private Sub Picture6_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Picture5.Cls
Picture7.Cls
jframe.danum = 5
jframe.rtop = 1
jframe.rleft = 1
jframe.rright = 65
jframe.rbottom = 29
jframe.ddrawc Picture6
End Sub
Private Sub Picture7_Click()
Unload Me
End Sub
Private Sub Picture7_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Picture6.Cls
Picture5.Cls
jframe.danum = 5
jframe.rtop = 1
jframe.rleft = 1
jframe.rright = 65
jframe.rbottom = 29
jframe.ddrawc Picture7
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -