cg_wlth_djb.frm

基于SQL2000的企业管理MRPII,包含进销存,财务,报关等组件,VB6开发,带文档说明.

      Height          =   495
      Left            =   3900
      Top             =   2880
      Width           =   2835
      _ExtentX        =   5001
      _ExtentY        =   873
      ConnectMode     =   0
      CursorLocation  =   3
      IsolationLevel  =   -1
      ConnectionTimeout=   15
      CommandTimeout  =   30
      CursorType      =   3
      LockType        =   3
      CommandType     =   8
      CursorOptions   =   0
      CacheSize       =   50
      MaxRecords      =   0
      BOFAction       =   0
      EOFAction       =   0
      ConnectStringType=   1
      Appearance      =   1
      BackColor       =   -2147483643
      ForeColor       =   -2147483640
      Orientation     =   0
      Enabled         =   -1
      Connect         =   ""
      OLEDBString     =   ""
      OLEDBFile       =   ""
      DataSourceName  =   ""
      OtherAttributes =   ""
      UserName        =   ""
      Password        =   ""
      RecordSource    =   ""
      Caption         =   "Ado_zztZ_xg"
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      _Version        =   393216
   End
   Begin MSAdodcLib.Adodc Ado_sc_kc 
      Height          =   525
      Left            =   4650
      Top             =   4050
      Width           =   2385
      _ExtentX        =   4207
      _ExtentY        =   926
      ConnectMode     =   0
      CursorLocation  =   3
      IsolationLevel  =   -1
      ConnectionTimeout=   15
      CommandTimeout  =   30
      CursorType      =   3
      LockType        =   3
      CommandType     =   8
      CursorOptions   =   0
      CacheSize       =   50
      MaxRecords      =   0
      BOFAction       =   0
      EOFAction       =   0
      ConnectStringType=   1
      Appearance      =   1
      BackColor       =   -2147483643
      ForeColor       =   -2147483640
      Orientation     =   0
      Enabled         =   -1
      Connect         =   ""
      OLEDBString     =   ""
      OLEDBFile       =   ""
      DataSourceName  =   ""
      OtherAttributes =   ""
      UserName        =   ""
      Password        =   ""
      RecordSource    =   ""
      Caption         =   "Ado_sc_kc"
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      _Version        =   393216
   End
   Begin TrueOleDBGrid60.TDBGrid TDBGrid3 
      Bindings        =   "Cg_wLtH_DjB.frx":19D27
      Height          =   6675
      Left            =   0
      OleObjectBlob   =   "Cg_wLtH_DjB.frx":19D42
      TabIndex        =   39
      Top             =   60
      Width           =   2595
   End
   Begin MSAdodcLib.Adodc Ado_cpxx 
      Height          =   615
      Left            =   600
      Top             =   3210
      Width           =   1695
      _ExtentX        =   2990
      _ExtentY        =   1085
      ConnectMode     =   0
      CursorLocation  =   3
      IsolationLevel  =   -1
      ConnectionTimeout=   15
      CommandTimeout  =   30
      CursorType      =   3
      LockType        =   3
      CommandType     =   8
      CursorOptions   =   0
      CacheSize       =   50
      MaxRecords      =   0
      BOFAction       =   0
      EOFAction       =   0
      ConnectStringType=   1
      Appearance      =   1
      BackColor       =   -2147483643
      ForeColor       =   -2147483640
      Orientation     =   0
      Enabled         =   -1
      Connect         =   ""
      OLEDBString     =   ""
      OLEDBFile       =   ""
      DataSourceName  =   ""
      OtherAttributes =   ""
      UserName        =   ""
      Password        =   ""
      RecordSource    =   ""
      Caption         =   "Ado_cpxx"
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      _Version        =   393216
   End
   Begin ResizeLibCtl.ReSize ReSize1 
      Left            =   900
      Top             =   5160
      _Version        =   196608
      _ExtentX        =   741
      _ExtentY        =   741
      _StockProps     =   64
      Enabled         =   -1  'True
      Enabled         =   -1  'True
      FormMinWidth    =   0
      FormMinHeight   =   0
      FormDesignHeight=   7425
      FormDesignWidth =   11445
   End
End
Attribute VB_Name = "Cg_wLtH_DjB"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Dim khdk, Combo7 As Adodb.Recordset
Dim ddxg_RPT As Adodb.Recordset
Dim zztz_rpt As Adodb.Recordset
Dim Tjbz As Boolean

Private Sub CMd_Find_Click()
On Error Resume Next
Set CX_FrM_SjY = Cg_wLtH_DjB.AdoprimaryRs
CX_SJy = "select * from cg_thdt 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 ("thdh(退货单号）")
  .Combo1(1).AddItem ("thdh(退货单号）")
  .Combo1(0).AddItem ("thpz(退货凭证）")
  .Combo1(1).AddItem ("thpz(退货凭证）")
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 cg_thdt set sh = '已审' where thdh='" & Text1(0).Text & "'"
 AdoprimaryRs.Recordset.Requery
 AdoprimaryRs.Recordset.Find ("thdh='" & Sh_Dh & "'")
End Sub

'*******************************************************
'*            曹汉华   2003.8.8  编写                 *
'*******************************************************
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()
cg_ylth_rpt.L_HzJe.Caption = HZJe(Val(Text1(7).Text))
cg_ylth_rpt.DataControl1.ConnectionString = Conn_Str
cg_ylth_rpt.DataControl1.Source = "SELECT cg_thdt.thdh,cg_thdt.phone,cg_thdt.fax,cg_thdt.gysmc,cg_thdt.djrq," & _
      "cg_thdt.thpz, cg_thd.shdbh,cg_thd.ylbh," & _
     "cg_thd.gyslh, cg_thd.lhdh, cg_thd.ylmc," & _
      "cg_thd.gg, cg_thd.yanse, cg_thd.caizh, cg_thd.dw," & _
      "cg_thd.sl, cg_thd.dj, cg_thd.je, cg_thd.thyy,cg_thd.cgdbh,cg_thd.bacp FROM cg_thd INNER JOIN cg_thdt ON cg_thd.thdh = cg_thdt.thdh where cg_thd.thdh='" & Text1(0).Text & "'"
cg_ylth_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()
Tjbz = False
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 = 0 And Cmdadd.Enabled = False Then
   Set khdk = New Adodb.Recordset
   khdk.Open "select * from sys_gyszl where gysbh='" & Combo(0).Text & "'", DB, adOpenStatic, adLockBatchOptimistic
   If khdk.RecordCount >= 1 Then
   khdk.MoveFirst
   AdoprimaryRs.Recordset.Fields("gysmc").Value = khdk!gysmc
   AdoprimaryRs.Recordset.Fields("phone").Value = khdk!Phone
    AdoprimaryRs.Recordset.Fields("fax").Value = khdk!Fax
   AdoprimaryRs.Recordset.Fields("bizh").Value = khdk!bizh
   AdoprimaryRs.Recordset.Fields("hl").Value = khdk!hl
   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 DTPicker1_Change()
If Check1.Value = 0 Then
AdoprimaryRs.ConnectionString = Conn_Str
AdoprimaryRs.RecordSource = "SELECT * FROM cg_thdt WHERE YEAR(djRQ)='" & DTPicker1.Year & "' AND MONTH(djRQ)='" & DTPicker1.Month & "' ORDER BY thdh"
Else
AdoprimaryRs.ConnectionString = Conn_Str
AdoprimaryRs.RecordSource = "SELECT * FROM cg_thdt WHERE djRQ='" & DTPicker1.Value & "' order BY thdh"
End If
AdoprimaryRs.Refresh
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) '非法退出禁止
If Cmdcancel.Enabled = True Then
If UnloadMode <> VBRUN.QueryUnloadConstants.vbFormCode Then
Cancel = 1
Exit Sub
End If
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
 Tjbz = False
 If SH_Right = True Then
    CmD_SH.Visible = True
    Else
    CmD_SH.Visible = False
 End If
 DTPicker1.Value = VBA.Date
 Cmdcancel.Enabled = False
 CmdOK.Enabled = False
 Call combo_load
 AdoprimaryRs.ConnectionString = Conn_Str
 AdoprimaryRs.RecordSource = "select * FROM cg_thdt where djrq='" & VBA.Date & "'"
 AdoprimaryRs.Refresh
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_BeforeColupdate(ByVal ColIndex As Integer, OldValue As Variant, Cancel As Integer)
If ColIndex = 8 Or ColIndex = 9 Or ColIndex = 12 Then
TDBGrid1.Columns(12).Value = Val(TDBGrid1.Columns(8).Value) * Val(TDBGrid1.Columns(9).Value)
Adodc_body_general.Recordset.Fields("zl").Value = Val(TDBGrid1.Columns(9).Value) * Val(TDBGrid1.Columns(21).Value)
End If
End Sub
Private Sub TDBGrid1_Change()
If TDBGrid1.Col = 0 And Cmdadd.Enabled = False Then
TDBGrid2.Visible = True
Ado_cpxx.ConnectionString = Conn_Str
Ado_cpxx.RecordSource = "select distinct * from cg_shd where shdbh like '%" & TDBGrid1.Columns(0).Text & "%' and gysbh='" & Combo(0).Text & "' order by shdbh,ylbh,cgdbh,ylmc,gg,dj"
Ado_cpxx.Refresh
'If Ado_cpxx.Recordset.RecordCount <= 0 Then
'MsgBox "此客户近期没有送货记录，不能退货!", vbOKOnly + 16, "系统提示"
'Call cmdCancel_Click
'Exit Sub
'End If