📄 yy_gysbj.frm

📁 基于SQL2000的企业管理MRPII,包含进销存,财务,报关等组件,VB6开发,带文档说明.
💻 FRM
📖 第 1 页 / 共 3 页
字号:
上一页 1 23
Dim tree_rec As Recordset
Dim khm As Recordset
Dim ddbha, combo2_data As Recordset
'*******************************************************
'*            曹汉华   2004.5.26 编写                 *
'*******************************************************

Private Sub CMd_Find_Click()
On Error Resume Next
Set CX_FrM_SjY = yy_gysbj.AdoprimaryRs
CX_SJy = "select * from yy_gysbjt where not gysbh is null  "
With SEC_Dialog
  .Combo1(0).Clear
  .Combo1(1).Clear
  .Combo1(0).AddItem ("gysbh(供方编号）")
  .Combo1(1).AddItem ("gysbh(供方编号）")
  .Combo1(0).AddItem ("gysmc(供方名称）")
  .Combo1(1).AddItem ("gysmc(供方名称）")
  .Combo1(0).AddItem ("bjdbh(报价单号）")
  .Combo1(1).AddItem ("bjdbh(报价单号）")
End With
Load SEC_Dialog
SEC_Dialog.Show 1
End Sub

Private Sub CmD_SH_Click()
Dim Sh_Dh As String
 Sh_Dh = Text1(0).Text
 DB.Execute "update yy_gysbjt set sh = '已审' where bjdbh='" & Text1(0).Text & "'"
 AdoprimaryRs.Recordset.Requery
 AdoprimaryRs.Recordset.Find ("bjdbh='" & Sh_Dh & "'")
End Sub
Private Sub cmdnext_Click() '向后
 On Error GoTo GoNextError
  If Not AdoprimaryRs.Recordset.EOF Then AdoprimaryRs.Recordset.MoveNext
  If AdoprimaryRs.Recordset.EOF And AdoprimaryRs.Recordset.RecordCount > 0 Then
    Beep
    AdoprimaryRs.Recordset.MoveLast
  End If
  Exit Sub
GoNextError:
  MsgBox Err.Description
End Sub
Private Sub CmdPrint_Click()
yy_gysbj_rpt.DataControl1.ConnectionString = Conn_Str
yy_gysbj_rpt.DataControl1.Source = "select yy_gysbjt.*,yy_gysbj.* from yy_gysbj inner join yy_gysbjt on yy_gysbj.bjdbh=yy_gysbjt.bjdbh where yy_gysbj.bjdbh='" & Text1(0).Text & "'"
yy_gysbj_rpt.Show VBRUN.FormShowConstants.vbModal
End Sub
Private Sub Cmdqd_Click() '首端
  If AdoprimaryRs.Recordset.RecordCount > 0 Then
  If AdoprimaryRs.BOFAction = False Then
  AdoprimaryRs.Recordset.MoveFirst
  Else
  AdoprimaryRs.Recordset.MoveNext
  End If
  Else
  Exit Sub
  End If
  End Sub
Private Sub Cmdreturn_Click()
Unload Me
End Sub

Private Sub cmdxq_Click() '向前
  On Error GoTo GoPrevError
  If Not AdoprimaryRs.Recordset.BOF Then AdoprimaryRs.Recordset.MovePrevious
  If AdoprimaryRs.Recordset.BOF And AdoprimaryRs.Recordset.RecordCount > 0 Then
    Beep
    AdoprimaryRs.Recordset.MoveFirst
  End If
  Exit Sub
GoPrevError:
  MsgBox Err.Description
End Sub

Private Sub cmdmd_Click() '末端
 If AdoprimaryRs.Recordset.RecordCount > 0 Then
 If AdoprimaryRs.Recordset.EOF = False Then
    AdoprimaryRs.Recordset.MoveLast
    Else
    AdoprimaryRs.Recordset.MovePrevious
 End If
 Else
 Exit Sub
 End If
End Sub

Private Sub Combo_Click(Index As Integer)
On Error Resume Next
If Index = 4 And Cmdadd.Enabled = False Then
   Set khdk = New Adodb.Recordset
   khdk.Open "select isnull(gysbh,'') as gysbh,isnull(gysmc,'') as gysmc,isnull(phone,'') as phone,isnull(fax,'') as fax,isnull(fkfs,'') as fkfs,isnull(zffs,'') as zffs,isnull(bizh,'') as bizh,isnull(hl,0) as hl,isnull(lxr,'') as lxr from sys_gyszl where gysbh='" & Combo(4).Text & "'", DB, adOpenStatic, adLockBatchOptimistic
    If khdk.RecordCount >= 1 Then
   khdk.MoveFirst
   AdoprimaryRs.Recordset.Fields("lxr").Value = khdk!lxr
   AdoprimaryRs.Recordset.Fields("gysmc").Value = khdk!gysmc
   AdoprimaryRs.Recordset.Fields("phone").Value = khdk!Phone
   AdoprimaryRs.Recordset.Fields("fax").Value = khdk!Fax
   AdoprimaryRs.Recordset.Fields("fkfs").Value = khdk!fkfs
   AdoprimaryRs.Recordset.Fields("bizh").Value = khdk!bizh
   AdoprimaryRs.Recordset.Fields("hl").Value = khdk!hl
   AdoprimaryRs.Recordset.Fields("zffs").Value = khdk!zffs
   AdoprimaryRs.Recordset.Fields("dizhi").Value = khdk!dizhi
   End If
End If
End Sub
Private Sub combo_KeyPress(Index As Integer, KeyAscii As Integer)
  If KeyAscii = 13 Then    ' 按回车
      KeyAscii = 0
      SendKeys "{TAB}"
   End If
End Sub



Private Sub Form_Load() '列表框数据
 Me.Width = main_FRM.Picture1.Width - 30
 Me.Top = main_FRM.ActiveBar21.Bands("Band7").Height * 2.5 - 65
 Me.Height = main_FRM.Picture1.Height - 300
 Me.Left = main_FRM.Picture1.Left + 15
  On Error Resume Next
  Call combo_load
  If SH_Right = True Then
    CmD_SH.Visible = True
    Else
    CmD_SH.Visible = False
  End If
  Ado_cpxx.ConnectionString = Conn_Str
  Ado_cpxx.RecordSource = "select * FROM sys_ylmc_B order by cpbh"
  Ado_cpxx.Refresh
  AdoprimaryRs.ConnectionString = Conn_Str '打开表头
  AdoprimaryRs.CommandType = adCmdUnknown
  AdoprimaryRs.RecordSource = "select* FROM yy_gysbjt ORDER BY gysmc,BJDBH"
  AdoprimaryRs.Refresh
  For i = 0 To Text1.Count - 1
  Text1(i).Locked = True
  Next i
  For i = 0 To Combo.Count - 1
  Combo(i).Locked = True
 Next i
 End Sub
Private Sub Form_Unload(Cancel As Integer)
  On Error Resume Next
  AdoprimaryRs.Recordset.Close
  Unload Me
End Sub

Private Sub T_Sh_Change()
If T_Sh.Text = "已审" And SH_Right = False Then
 ' Cmdedit.Visible = False
  Cmddelete.Visible = False
  Else
 ' Cmdedit.Visible = True
  Cmddelete.Visible = True
End If
End Sub
Private Sub T_Sh_GotFocus()
SendKeys "{TAB}"
End Sub
Private Sub TDBGrid1_Change()
If TDBGrid1.Col = 0 And Cmdadd.Enabled = False Then
TDBGrid2.Visible = True
Ado_cpxx.RecordSource = "select sys_ylmc_b.* from sys_ylmc_b where sys_ylmc_b.cpbh_s like '%" & TDBGrid1.Columns(0).Text & "%' and sys_ylmc_b.cpbh_s not in (select isnull(ylbh,'') as cpbh from yy_gysbj where gysbh='" & Combo(4).Text & "') order by cpbh,cpmc,gg"
Ado_cpxx.Refresh
End If
End Sub

'表格记录删除 2002年9月18日 曹汉华
Private Sub TDBGrid1_KeyDown(KeyCode As Integer, Shift As Integer)
On Error Resume Next
If Cmdadd.Enabled = False Then
   If KeyCode = 46 Then
   Adodc_body_general.Recordset.Delete
   Adodc_body_general.Recordset.UpdateBatch adAffectAll
   Adodc_body_general.Refresh
   End If
End If
End Sub
Private Sub TDBGrid2_Click()
On Error Resume Next
TDBGrid1.Columns(0).Value = TDBGrid2.Columns(0).Value
TDBGrid1.Columns(1).Value = TDBGrid2.Columns(1).Value
TDBGrid1.Columns(2).Value = TDBGrid2.Columns(2).Value
TDBGrid1.Columns(3).Value = TDBGrid2.Columns(3).Value
TDBGrid1.Columns(4).Value = TDBGrid2.Columns(4).Value
TDBGrid1.Columns(5).Value = TDBGrid2.Columns(5).Value
TDBGrid1.Columns(6).Value = TDBGrid2.Columns(6).Value
TDBGrid1.Columns(7).Value = TDBGrid2.Columns(7).Value
TDBGrid1.Columns(12).Value = TDBGrid2.Columns(9).Value
TDBGrid1.Columns(13).Value = TDBGrid2.Columns(8).Value
TDBGrid1.Columns(14).Value = TDBGrid2.Columns(10).Value
TDBGrid1.Columns(15).Value = TDBGrid2.Columns(11).Value
TDBGrid1.Columns(10).Value = Trim(Combo(4).Text)
TDBGrid1.Columns(8).Value = Trim(Text1(0).Text)
TDBGrid1.Columns(11).Value = Str(TDBGrid1.Row + 1)
TDBGrid1.Columns(9).Value = CVDate(Text1(2).Text)
End Sub
Private Sub Text1_Change(Index As Integer)
On Error Resume Next
Adodc_body_general.ConnectionString = Conn_Str
Adodc_body_general.RecordSource = "select * from yy_gysbj with (nolock) where bjdbh='" & Text1(0).Text & "'order by ylmc"
Adodc_body_general.Refresh
End Sub
Private Sub text1_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
If KeyCode = 40 Then        '向下箭头
   If Index + 1 < Text1.Count Then
   Text1(Index + 1).SetFocus
   Else
   Text1(0).SetFocus
  End If
End If
If KeyCode = 38 Then        '向上箭头
  If Index - 1 >= 0 Then
  Text1(Index - 1).SetFocus
  Else
  Text1(Text1.Count - 1).SetFocus
  End If
End If
End Sub


Private Sub Cmdadd_Click()   '添加
 On Error Resume Next
  Dim bxh As Recordset
  Set bxh = New Recordset
  bxh.Open "select distinct bjdbh from yy_gysbjt order by bjdbh asc", DB, adOpenStatic
  cmdxq.Enabled = False
  CmD_SH.Enabled = False
  cmdnext.Enabled = False
  cmdmd.Enabled = False
  cmdqd.Enabled = False
  CmD_FinD.Enabled = False
  Cmdprint.Enabled = False
  TDBGrid3.Enabled = False
  Cmddelete.Enabled = False
  Cmdadd.Enabled = False
  Cmdedit.Enabled = False
  Cmdreturn.Enabled = False
  CmdOK.Enabled = True
  Cmdcancel.Enabled = True
  TDBGrid1.AllowDelete = True
  TDBGrid1.AllowUpdate = True
If bxh.RecordCount < 1 Then
 bh = "0001"
 Else
 bxh.MoveLast
 bhx = Trim(Str(Val(Right(bxh.Fields("bjdbh").Value, 4)) + 1))
 If Len(bhx) < 2 Then
  bh = "000" & bhx
 End If
 If Len(bhx) = 2 Then
   bh = "00" + bhx
 End If
 If Len(bhx) = 3 Then
  bh = "0" + bhx
 End If
 If Len(bhx) > 3 Then
 bh = bhx
 End If
End If
 On Error GoTo AddErr
If AdoprimaryRs.Recordset.RecordCount > 0 Then
   AdoprimaryRs.Recordset.MoveLast
End If
AdoprimaryRs.Recordset.AddNew
For i = 0 To Text1.Count - 1
  Text1(i).Locked = False
Next i
For i = 0 To Combo.Count - 1
 Combo(i).Locked = False
Next i
Text1(0).Text = "GJ" & bh
Text1(2).Text = VBA.Date
Exit Sub
AddErr:
 MsgBox Err.Description
End Sub


Private Sub cmdDelete_Click() '删除
  BJH = Trim(Text1(0).Text)
  On Error Resume Next
   If MsgBox("是否真的删除当前记录 ？", vbYesNo + 32, "系统提示") = vbYes Then
  Adodc_body_general.Recordset.ActiveConnection.Execute "delete from yy_gysbj where bjdbh='" & BJH & "'"
  Adodc_body_general.Recordset.UpdateBatch adAffectAll
  If AdoprimaryRs.Recordset.RecordCount > 0 Then
  With AdoprimaryRs
    .Recordset.Delete
    If .Recordset.EOF = False Then .Refresh
     If AdoprimaryRs.Recordset.RecordCount > 0 Then
    .Recordset.MoveLast
    Else
    Exit Sub
    End If
    End With
    Else
  Exit Sub
  End If
  AdoprimaryRs.Refresh
  Adodc_body_general.Refresh
  Else
  Exit Sub
  End If
End Sub

Private Sub cmdEdit_Click() '修改
 On Error GoTo EditErr
 TDBGrid1.AllowDelete = True
 TDBGrid1.AllowUpdate = True
  For i = 0 To Text1.Count - 1
      Text1(i).Locked = False
  Next i
  For i = 0 To Combo.Count - 1
  Combo(i).Locked = False
  Next i
  CmD_SH.Enabled = False
  cmdxq.Enabled = False
  cmdnext.Enabled = False
  cmdmd.Enabled = False
  cmdqd.Enabled = False
  CmD_FinD.Enabled = False
  Cmdprint.Enabled = False
  TDBGrid3.Enabled = False
  Cmddelete.Enabled = False
  Cmdadd.Enabled = False
  Cmdedit.Enabled = False
  Cmdreturn.Enabled = False
  CmdOK.Enabled = True
  Cmdcancel.Enabled = True
  Exit Sub
EditErr:
  MsgBox Err.Description
End Sub
Private Sub cmdCancel_Click() '取消
  TDBGrid1.AllowDelete = False
  TDBGrid1.AllowUpdate = False
  For i = 0 To Text1.Count - 1
      Text1(i).Locked = True
  Next i
  For i = 0 To Combo.Count - 1
  Combo(i).Locked = True
  Next i
  CmD_SH.Enabled = True
  cmdxq.Enabled = True
  cmdnext.Enabled = True
  cmdmd.Enabled = True
  cmdqd.Enabled = True
  CmD_FinD.Enabled = True
  Cmdprint.Enabled = True
  TDBGrid3.Enabled = True
  Cmddelete.Enabled = True
  Cmdadd.Enabled = True
  Cmdedit.Enabled = True
  Cmdreturn.Enabled = True
  CmdOK.Enabled = False
  Cmdcancel.Enabled = False
  On Error Resume Next
  AdoprimaryRs.Recordset.CancelUpdate
  If mvBookMark > 0 Then
    AdoprimaryRs.Recordset.Bookmark = mvBookMark
  Else
    AdoprimaryRs.Recordset.MoveFirst
  End If
  TDBGrid2.Visible = False
End Sub

Private Sub cmdOK_Click()    '确认
TDBGrid1.MoveNext
TDBGrid2.Visible = False
TDBGrid1.AllowDelete = False
TDBGrid1.AllowUpdate = False
If Text1(0).Text = "" Then
   MsgBox "所有名称不能为空", 48, "提示"
   Text1(0).SetFocus
   Exit Sub
End If
  For i = 0 To Text1.Count - 1
      Text1(i).Locked = True
  Next i
 For i = 0 To Combo.Count - 1
  Combo(i).Locked = True
 Next i
  CmD_SH.Enabled = True
  cmdxq.Enabled = True
  cmdnext.Enabled = True
  cmdmd.Enabled = True
  cmdqd.Enabled = True
  CmD_FinD.Enabled = True
  Cmdprint.Enabled = True
  TDBGrid3.Enabled = True
  Cmddelete.Enabled = True
  Cmdadd.Enabled = True
  Cmdedit.Enabled = True
  Cmdreturn.Enabled = True
  CmdOK.Enabled = False
  Cmdcancel.Enabled = False
  On Error GoTo UpdateErr
  AdoprimaryRs.Recordset.UpdateBatch adAffectAll
  Adodc_body_general.Recordset.UpdateBatch adAffectAll
  If AdoprimaryRs.Recordset.BOF Then
     AdoprimaryRs.Recordset.MovePrevious
     AdoprimaryRs.Recordset.MoveNext
     Else
     AdoprimaryRs.Recordset.MoveNext
     AdoprimaryRs.Recordset.MovePrevious
  End If
  Exit Sub
  AdoprimaryRs.Recordset.UpdateBatch adAffectAll
  Adodc_body_general.Recordset.UpdateBatch adAffectAl
  Cmdcancel.Enabled = False
  CmdOK.Enabled = False
 ' Call tree_load
 Exit Sub
UpdateErr:
  MsgBox Err.Description
End Sub

Private Sub text1_KeyPress(Index As Integer, KeyAscii As Integer)
   If KeyAscii = 13 Then    ' 按回车
      KeyAscii = 0
      SendKeys "{TAB}"
   End If
End Sub

Sub combo_load()
Dim combo2_data As Recordset
Set combo2_data = New Recordset
 combo2_data.Open "select DISTINCT gysbh from sys_gyszl where not gysbh is null", DB, adOpenStatic, adLockOptimistic
 If combo2_data.RecordCount > 0 Then
   For i = 1 To combo2_data.RecordCount
     Combo(4).AddItem (combo2_data.Fields("gysbh"))
   If combo2_data.EOF = False Then
     combo2_data.MoveNext
   End If
   Next i
 combo2_data.MoveFirst
 Else
 Exit Sub
 End If
End Sub
上一页 1 23
⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -