【VB开源代码栏目提醒】:文章导读:在新的一年中,各位网友都进入紧张的学习或是工作阶段。网学会员整理了VB开源代码-frmInquireOZC.frm的相关内容供大家参考,祝大家在新的一年里工作和学习顺利!
VERSION 5.00
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "Msflxgrd.ocx"
Begin VB.Form frmInquireOZC
Caption = "转仓信息
列表——按转出"
ClientHeight = 3210
ClientLeft = 60
ClientTop = 345
ClientWidth = 7815
LinkTopic = "Form1"
MDIChild = -1 'True
ScaleHeight = 3210
ScaleWidth = 7815
WindowState = 2 'Maximized
Begin MSFlexGridLib.MSFlexGrid msgList
Height = 2292
Left = 120
TabIndex = 1
Top = 720
Width = 7572
_ExtentX = 13361
_ExtentY = 4048
_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 = 255
Left = 120
TabIndex = 0
Top = 240
Width = 3015
End
End
Attribute
VB_Name = "frmInquireOZC"
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 MsgText As String
Dim mintRW As Integer
'状态条中显示的时间信息
Public msBarText As String
Public reportName As String
Public reportSQL As String
Private Sub Form_Activate()
'设置读写权限
SetWorkRW mintRW
fMainForm.sbStatusBar.Panels(1).Text = msBarText
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 per
mission where module=13 and id='" & sUserName & " '"
Set recTemp = ExecuteSQL(sSQL, MsgText)
If recTemp.EOF = False Then
mintRW = PRINTMODE
Else
mintRW = ERRORMODE
SetMdiEnv
MsgBox "您的帐号权限有错误!", vbOKOnly + vbCritical, "错误"
Exit Sub
End If
reportName = "inquireZC.rpt"
'设置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 - 200
End If
End Sub
Public Sub FormClose()
Unload Me
End Sub
'显示Grid的内容
Private Sub ShowData()
Dim j As Integer
Dim i As Integer
Set mrc = ExecuteSQL(txtSQL, MsgText)
With msgList
.Rows = 1
Do While Not mrc.EOF
.Rows = .Rows + 1
For i = 1 To mrc.Fields.Count
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
Next i
mrc.MoveNext
Loop
End With
mrc.Close
End Sub
'显示Grid表头
Private Sub ShowTitle()
Dim i As Integer
With msgList
.Cols = 14
.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) = "备注信息"
'固定表头
.FixedRows = 1
'设置各列的对齐方式
For i = 0 To 13
.ColAlignment(i) = 0
Next i
'表头项居中
.FillStyle = flexFillRepeat
.Col = 0
.Row = 0
.RowSel = 1
.ColSel = .Cols - 1
.CellAlignment = 4
'设置单元大小
.ColWidth(0) = 300
.ColWidth(1) = 1000
.ColWidth(2) = 1000
.ColWidth(3) = 2000
.ColWidth(4) = 2000
.ColWidth(5) = 1000
.ColWidth(6) = 1000
.ColWidth(7) = 600
.ColWidth(8) = 1000
.Co