📄 frmoffer.frm
字号:
VERSION 5.00
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "Msflxgrd.ocx"
Begin VB.Form frmOFFER
Caption = "应付信息列表"
ClientHeight = 6765
ClientLeft = 45
ClientTop = 345
ClientWidth = 8505
LinkTopic = "Form1"
MDIChild = -1 'True
ScaleHeight = 6765
ScaleWidth = 8505
WindowState = 2 'Maximized
Begin MSFlexGridLib.MSFlexGrid msgList
Height = 3132
Left = 240
TabIndex = 0
Top = 600
Width = 7452
_ExtentX = 13150
_ExtentY = 5530
_Version = 393216
Cols = 4
FixedCols = 3
AllowUserResizing= 1
End
Begin VB.Label lblTitle
Caption = "应 付 信 息 列 表"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H8000000D&
Height = 252
Left = 1560
TabIndex = 1
Top = 240
Width = 3012
End
End
Attribute VB_Name = "frmOFFER"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public txtSQL As String
Dim mrc As ADODB.Recordset
'用户的读写权限标识
Dim mintRW As Integer
'状态条中显示的时间信息
Public msBarText As String
Public reportSQL As String
Public Sub OfferMoney()
Dim intCount As Integer
If msgList.Rows > 1 Then
intCount = msgList.Row
If intCount > 0 Then
frmOFFER1.txtSQL = "select inh.inh_no,inh.in_date,inh.gfdm,dm_gf.mc,inh.wzdm,dm_wz.mc,inh.qihao,inh.sl,inh.in_danj,inh.i_zk,inh.i_zke,inh.jz,inh.yf,inh.bz from inh inner join dm_gf on inh.gfdm = dm_gf.dm inner join dm_wz on inh.wzdm = dm_wz.dm where inh_no ='" & Trim(msgList.TextMatrix(intCount, 1)) & "'"
frmOFFER1.Show 1
Else
MsgBox "警告", vbOKOnly + vbExclamation, "请首先选择付款登记的纪录!"
End If
End If
End Sub
Private Sub Form_Activate()
'设置读写权限
SetWorkRW mintRW
With fMainForm
.mnuWorkOffer.Visible = True
.tbToolBar.Buttons.Item("Offer").Enabled = True
.mnuWorkAdd.Visible = False
.mnuWorkDelete.Visible = False
.mnuWorkEdit.Visible = False
.tbToolBar.Buttons.Item("Add").Enabled = False
.tbToolBar.Buttons.Item("Delete").Enabled = False
.tbToolBar.Buttons.Item("Edit").Enabled = False
.mnuWork.Visible = False
'.mnuSysClose.Enabled = True
.tbToolBar.Buttons.Item("Find").Enabled = False
.tbToolBar.Buttons.Item("Refresh").Enabled = False
End With
End Sub
Private Sub Form_Load()
'用户操作权限
Dim sPermission As String
Dim recTemp As Recordset
Dim sSQL As String
Dim sByte As String
Dim MsgText As String
On Error GoTo myErr
'设置操作的表名称
'msTableName = "ampaytune"
'msRptName = "paytune.rpt"
'msOrderBy = " order by tzdate,tzid"
'sOrder0 = "+ {tzdate}"
'sOrder1 = "+ {tzid}"
'msSelect = "select * from "
'置mintRW初值
mintRW = 0
sSQL = "select rw from permission where module=14 and id='" & sUserName & " '"
Set recTemp = ExecuteSQL(sSQL, MsgText)
If recTemp.EOF = False Then
mintRW = CInt(recTemp!rw)
Else
mintRW = ERRORMODE
SetMdiEnv
MsgBox "您的帐号权限有错误!", vbOKOnly + vbCritical, "错误"
Exit Sub
End If
'设置msSql
'msSql = msSelect & msTableName & " where tzdate>='" & Format(DateAdd("m", -1, Now), "yyyy-mm-dd") & "' and tzdate<='" & Format(Now, "yyyy-mm-dd") & "'" & msOrderBy
'显示数据
msBarText = "当前数据时间范围:" & Format(DateAdd("m", -1, Now), "yyyy-mm-dd") & "至" & Format(Now, "yyyy-mm-dd")
ShowTitle
ShowData
Set recTemp = Nothing
Exit Sub
myErr:
ShowError
End Sub
Private Sub Form_Resize()
If Me.WindowState <> vbMinimized And fMainForm.WindowState <> vbMinimized Then
'边界处理
If Me.ScaleHeight < 10 * lblTitle.Height Then
Exit Sub
End If
If Me.ScaleWidth < lblTitle.Width + lblTitle.Width / 2 Then
Exit Sub
End If
'控制控件的位置
lblTitle.Top = lblTitle.Height
lblTitle.Left = (Me.Width - lblTitle.Width) / 2
msgList.Top = lblTitle.Top + lblTitle.Height + lblTitle.Height / 2
msgList.Width = Me.ScaleWidth - 200
msgList.Left = Me.ScaleLeft + 100
msgList.Height = Me.ScaleHeight - msgList.Top
End If
End Sub
Public Sub FormClose()
Unload Me
End Sub
Private Sub ShowData()
Dim j As Integer
Dim i As Integer
Dim MsgText As String
Set mrc = ExecuteSQL(txtSQL, MsgText)
With msgList
.Rows = 1
Do While Not mrc.EOF
.Rows = .Rows + 1
For i = 1 To mrc.Fields.Count
If Not IsNull(Trim(mrc.Fields(i - 1))) Then
Select Case mrc.Fields(i - 1).Type
Case adDBDate
.TextMatrix(.Rows - 1, i) = Format(mrc.Fields(i - 1) & "", "yyyy-mm-dd")
Case Else
.TextMatrix(.Rows - 1, i) = mrc.Fields(i - 1) & ""
End Select
End If
Next i
mrc.MoveNext
Loop
End With
mrc.Close
End Sub
Private Sub ShowTitle()
Dim i As Integer
With msgList
.Cols = 15
.TextMatrix(0, 1) = "进货单编号"
.TextMatrix(0, 2) = "进货日期"
.TextMatrix(0, 3) = "供货商编号"
.TextMatrix(0, 4) = "供货商名称"
.TextMatrix(0, 5) = "商品编号"
.TextMatrix(0, 6) = "商品名称"
.TextMatrix(0, 7) = "商品期号"
.TextMatrix(0, 8) = "数量"
.TextMatrix(0, 9) = "进货单价"
.TextMatrix(0, 10) = "进货折扣"
.TextMatrix(0, 11) = "总金额"
.TextMatrix(0, 12) = "是否记账"
.TextMatrix(0, 13) = "预付比例"
.TextMatrix(0, 14) = "备注信息"
'固定表头
.FixedRows = 1
'设置各列的对齐方式
For i = 0 To 14
.ColAlignment(i) = 0
Next i
'表头项居中
.FillStyle = flexFillRepeat
.Col = 0
.Row = 0
.RowSel = 1
.ColSel = .Cols - 1
.CellAlignment = 4
'设置单元大小
.ColWidth(0) = 1000
.ColWidth(1) = 1000
.ColWidth(2) = 1000
.ColWidth(3) = 1000
.ColWidth(4) = 1000
.ColWidth(5) = 1500
.ColWidth(6) = 1500
.ColWidth(7) = 1500
.ColWidth(8) = 3000
.ColWidth(9) = 1000
.ColWidth(10) = 1500
.ColWidth(11) = 1500
.ColWidth(12) = 1500
.ColWidth(13) = 3000
.ColWidth(14) = 3000
.Row = 1
End With
End Sub
Private Sub Form_Unload(Cancel As Integer)
SetMdiEnv
End Sub
Private Sub msgList_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
'右键弹出
If Button = 2 And Shift = 0 Then
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -