firdh.frm

一个机械产品（产品、部件、零件）的工时、工资及进度软件

VERSION 5.00
Object = "{4F29B06F-16D9-4A0C-9C8A-2F0C02F625FE}#1.0#0"; "FlexCell.ocx"
Begin VB.Form firdh 
   Caption         =   "订货单位"
   ClientHeight    =   6960
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   11880
   LinkTopic       =   "Form1"
   MDIChild        =   -1  'True
   ScaleHeight     =   6960
   ScaleWidth      =   11880
   Begin FlexCell.Grid Grid1 
      Height          =   5535
      Left            =   150
      TabIndex        =   8
      Top             =   720
      Width           =   11655
      _ExtentX        =   20558
      _ExtentY        =   9763
      Cols            =   5
      Rows            =   30
   End
   Begin VB.TextBox txtcode 
      Height          =   285
      Left            =   9240
      TabIndex        =   5
      Top             =   360
      Width           =   615
   End
   Begin VB.Frame Frame1 
      Height          =   615
      Left            =   7140
      TabIndex        =   0
      Top             =   6300
      Width           =   4455
      Begin VB.CommandButton cmddelete 
         Caption         =   "删行"
         Height          =   255
         Left            =   2064
         TabIndex        =   4
         Top             =   240
         Width           =   795
      End
      Begin VB.CommandButton cmdexit 
         Caption         =   "退出"
         Height          =   255
         Left            =   3180
         TabIndex        =   3
         Top             =   240
         Width           =   795
      End
      Begin VB.CommandButton cmdsave 
         Caption         =   "保存"
         Height          =   255
         Left            =   1092
         TabIndex        =   2
         Top             =   240
         Width           =   795
      End
      Begin VB.CommandButton cmdadd 
         Caption         =   "增加"
         Height          =   255
         Left            =   120
         TabIndex        =   1
         Top             =   240
         Width           =   795
      End
   End
   Begin VB.Label Label1 
      Caption         =   " 订　　货　　单　　位"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   13.5
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FF0000&
      Height          =   435
      Index           =   4
      Left            =   4020
      TabIndex        =   7
      Top             =   120
      Width           =   3315
   End
   Begin VB.Label Label2 
      Caption         =   "注：编号最长4位，名称最长8位"
      Height          =   315
      Left            =   180
      TabIndex        =   6
      Top             =   6360
      Width           =   5655
   End
End
Attribute VB_Name = "firdh"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'为保证数据库结构的完整性，对单位编号不作更改与删除，只可更改其它内容

Option Explicit
Private Sub Form_Load()
    Me.Width = 12000
    Me.Height = 7470
    
    Grid1.AutoRedraw = False
    Grid1.AllowUserSort = True
    Grid1.AllowUserResizing = False
    Grid1.DisplayFocusRect = False
    Grid1.ExtendLastCol = True
  
    Grid1.Cols = 7
    Grid1.Rows = 1
    Grid1.FixedRows = 1
    
    Grid1.Column(0).Width = 18
    Grid1.Column(1).Width = 80
    Grid1.Column(2).Width = 160
    Grid1.Column(3).Width = 160
    Grid1.Column(4).Width = 60
    Grid1.Column(5).Width = 120
    Grid1.Column(6).Width = 120
     
    dogridfill
    Grid1.Column(1).Locked = True         '单位编号自动产生，禁止用户修改
    Grid1.AutoRedraw = True
    Grid1.Refresh
    
    Set rsTempA = oDb.Execute("select max(dhbh) as maxcode from adh ")    'code号初始
    If IsNull(rsTempA!maxcode) Then
        txtcode.Text = 1000
        Else
        txtcode.Text = rsTempA!maxcode + 1
    End If
    txtcode.Visible = False
    cmddelete.Enabled = False
End Sub

Private Sub dogridfill()
    Grid1.Cell(0, 1).Text = "单位编号"
    Grid1.Cell(0, 2).Text = "单位名称"
    Grid1.Cell(0, 3).Text = "单位地址"
    Grid1.Cell(0, 4).Text = "联系人"
    Grid1.Cell(0, 5).Text = "电话"
    Grid1.Cell(0, 6).Text = "传真"
    
    szSql = "select * from adh  order by dhbh"
    Set rsTempA = oDb.Execute(szSql)
    Do While Not rsTempA.EOF
        Grid1.AddItem (rsTempA!dhbh & Chr(9) & rsTempA!dhmc & Chr(9) & rsTempA!dhadd & Chr(9) & rsTempA!dhxm & Chr(9) & rsTempA!dhtel & Chr(9) & rsTempA!dhfax)
        rsTempA.MoveNext
    Loop
End Sub
Private Sub cmddelete_Click()
    i = Grid1.ActiveCell.Row
    griditem = Grid1.Cell(i, 1).Text
    answer = MsgBox("删除此行？" & griditem, vbYesNo, "删除")
    If answer = 6 Then
        szSql = "delete from agx where gxbh='" & griditem & "'"
        oDb.Execute szSql
        Grid1.Selection.DeleteByRow
        Grid1.Rows = 1
        dogridfill
    End If
End Sub
Private Sub cmdexit_Click()
    Unload Me
End Sub
  
Private Sub cmdadd_Click()
    Grid1.Rows = Grid1.Rows + 1
    Grid1.Cell(Grid1.Rows - 1, 1).Text = txtcode.Text
    txtcode.Text = Val(txtcode.Text) + 1
End Sub
Private Sub cmdsave_Click()
    For i = 1 To Grid1.Rows - 1
        If Grid1.Cell(i, 2).Text = "" Then
            MsgBox "请输入单位名称", vbOKOnly, "单位"
            Exit Sub
        End If
    Next i
    
    For i = 1 To Grid1.Rows - 1
        griditem = Grid1.Cell(i, 1).Text
        Set rsTempA = oDb.Execute("select dhbh from adh where dhbh='" & griditem & "'")
        If rsTempA.RecordCount < 1 Then  '增加保存
            griditem = "'" & Grid1.Cell(i, 1).Text & "','" & Grid1.Cell(i, 2).Text & "'"
            If Grid1.Cell(i, 3).Text <> "" Then griditem = griditem & ",'" & Grid1.Cell(i, 3).Text & "'" Else griditem = griditem & ",''"
            If Grid1.Cell(i, 4).Text <> "" Then griditem = griditem & ",'" & Grid1.Cell(i, 4).Text & "'" Else griditem = griditem & ",''"
            If Grid1.Cell(i, 5).Text <> "" Then griditem = griditem & ",'" & Grid1.Cell(i, 5).Text & "'" Else griditem = griditem & ",''"
            If Grid1.Cell(i, 6).Text <> "" Then griditem = griditem & ",'" & Grid1.Cell(i, 6).Text & "'" Else griditem = griditem & ",''"
        
            szSql = "insert adh (dhbh,dhmc,dhadd,dhxm,dhtel,dhfax) values (" & griditem & ")"
            oDb.Execute szSql
        Else
            szSql = "UPDATE adh SET dhmc='" & Grid1.Cell(i, 2).Text & "',dhadd='" & Grid1.Cell(i, 3).Text & "',dhxm='" & Grid1.Cell(i, 4).Text & "',dhtel='" & Grid1.Cell(i, 5).Text & "',dhfax='" & Grid1.Cell(i, 6).Text & "' where dhbh='" & Grid1.Cell(i, 1).Text & "'"
            oDb.Execute szSql

        End If
    Next i
    MsgBox "成功保存", vbOKOnly, "保存"
    cmdsave.Enabled = False
End Sub