【VB开源代码栏目提醒】:网学会员为需要VB开源代码的朋友们搜集整理了frmDH.frm相关资料,希望对各位网友有所帮助!
VERSION 5.00
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "Msflxgrd.ocx"
Begin VB.Form frmDH
Caption = "进货订单信息
列表"
ClientHeight = 4995
ClientLeft = 45
ClientTop = 345
ClientWidth = 7560
LinkTopic = "Form1"
MDIChild = -1 'True
ScaleHeight = 4995
ScaleWidth = 7560
WindowState = 2 'Maximized
Begin VB.Frame Frame2
Caption = "记录操作"
Height = 972
Left = 960
TabIndex = 1
Top = 3960
Width = 6000
Begin VB.CommandButton cmdDelete
Caption = "删除"
Height = 375
Left = 4080
TabIndex = 4
Top = 360
Width = 1700
End
Begin VB.CommandButton cmdModify
Caption = "修改"
Height = 375
Left = 2160
TabIndex = 3
Top = 360
Width = 1700
End
Begin
VB.CommandButton cmdAdd
Caption = "添加"
Height = 375
Left = 240
TabIndex = 2
Top = 360
Width = 1700
End
End
Begin MSFlexGridLib.MSFlexGrid msgList
Height = 3132
Left = 0
TabIndex = 5
Top = 720
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 = 1680
TabIndex = 0
Top = 120
Width = 4932
End
End
Attribute VB_Name = "frmdh"
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
Public Sub RecordFind()
'
End Sub
Public Sub RecordRefresh()
'显示数据
msBarText = "当前数据时间范围:" & Format(DateAdd("m", -1, Now), "yyyy-mm-dd") & "至" & Format(Now, "yyyy-mm-dd")
ShowData
End Sub
Public Sub RecordAdd()
gintDHmode = 1
frmdh1.Show 1
End Sub
'删除记录
Public Sub RecordDelete()
Dim sSql As String
Dim intCount As Integer
Dim recTemp As ADODB.Recordset
Dim MsgText As String
On Error GoTo myErr
If msgList.Rows > 1 Then
If MsgBox("真的要删除编号为" & Trim(msgList.TextMatrix(msgList.Row, 1)) & "的进货单记录吗?", vbOKCancel + vbExclamation, "警告") = vbOK Then
intCount = msgList.Row
sSql = "delete from dh where dh_no ='" & Trim(msgList.TextMatrix(intCount, 1)) & "'"
Set recTemp = ExecuteSQL(sSql, MsgText)
'Unload frmCKSetup
'frmCKSetup.txtSQL = "select * from dm_ck"
'frmCKSetup.Show
ShowData
End If
End If
Exit Sub
myErr:
ShowError
'Dim txtSQL As String
'Dim intCount As Integer
'Dim mrc As ADODB.Recordset
'Dim MsgText As String
'If msgList.Rows > 1 Then
' intCount = msgList.Row
' txtSQL = "delete from dh where dh_no ='" & Trim(msgList.TextMatrix(intCount, 1)) & "'"
' Set mrc = ExecuteSQL(txtSQL, MsgText)
' Unload frmdh
' frmdh.txtSQL = "select dh_no,in_date,ywman,gfdm,wzdm,qihao,sl,in_danj,i_zk,i_zke,bz from dh"
' frmdh.Show
' End If
'End If
End Sub
Public Sub RecordEdit()
Dim intCount As Integer
If frmdh.msgList.Rows > 1 Then
gintDHmode = 2
intCount = msgList.Row
If intCount > 0 Then
frmdh1.txtSQL = "select * from dh where dh_no ='" & Trim(msgList.TextMatrix(intCount, 1)) & "'"
frmdh1.Show 1
Else
MsgBox "警告", vbOKOnly + vbExclamation, "请首先选择需要修改的纪录!"
End If
ShowData
Else
Call RecordAdd
End If
End Sub
Private Sub cmdAdd_Click()
gintDHmode = 1
frmdh1.Show 1
End Sub
Private Sub cmdModify_Click()
Dim intCount As Integer
If frmdh.msgList.Rows > 1 Then
gintDHmode = 2
intCount = msgList.Row
If intCount > 0 Then
frmdh1.txtSQL = "select * from dh where dh_no ='" & Trim(msgList.TextMatrix(intCount, 1)) & "'"
frmdh1.Show 1
Else
MsgBox "警告", vbOKOnly + vbExclamation, "请首先选择需要修改的纪录!"
End If
End If
End Sub
Private Sub Form_Activate()
'设置读写权限
SetWorkRW mintRW
fMainForm.sbStatusBar.Panels(1).Text = msBarText
End Sub
Private Sub Form_Load()
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=11 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
ShowDat