frmphserialgl.frm

这是用Visual Basic6开发的大型喷绘业务管理系统,数据库采用Access数据库

VERSION 5.00
Begin VB.Form frmPHserialGL 
   BorderStyle     =   0  'None
   Caption         =   "喷绘序列管理"
   ClientHeight    =   3690
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   6420
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   Picture         =   "frmPHserialGL.frx":0000
   ScaleHeight     =   3690
   ScaleWidth      =   6420
   StartUpPosition =   2  '屏幕中心
   Begin VB.PictureBox Picture2 
      AutoSize        =   -1  'True
      BorderStyle     =   0  'None
      Height          =   345
      Left            =   3990
      Picture         =   "frmPHserialGL.frx":4EDFA
      ScaleHeight     =   23
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   80
      TabIndex        =   5
      Top             =   2730
      Width           =   1200
   End
   Begin VB.PictureBox Picture1 
      AutoSize        =   -1  'True
      BorderStyle     =   0  'None
      Height          =   345
      Left            =   1710
      Picture         =   "frmPHserialGL.frx":503CC
      ScaleHeight     =   23
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   80
      TabIndex        =   4
      Top             =   2730
      Width           =   1200
   End
   Begin VB.TextBox Text2 
      Appearance      =   0  'Flat
      Height          =   285
      Left            =   2910
      TabIndex        =   0
      Top             =   1440
      Width           =   1965
   End
   Begin VB.TextBox Text3 
      Appearance      =   0  'Flat
      Height          =   285
      Left            =   2910
      TabIndex        =   1
      Top             =   1890
      Width           =   1965
   End
   Begin VB.TextBox Text1 
      Appearance      =   0  'Flat
      Height          =   285
      Left            =   2910
      TabIndex        =   3
      Top             =   1020
      Width           =   1965
   End
   Begin VB.Image Image2 
      Height          =   585
      Left            =   840
      Picture         =   "frmPHserialGL.frx":5199E
      Top             =   870
      Width           =   555
   End
   Begin VB.Label Label1 
      BackStyle       =   0  'Transparent
      Caption         =   "级    别"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   225
      Index           =   1
      Left            =   1860
      TabIndex        =   8
      Top             =   1050
      Width           =   1125
   End
   Begin VB.Label Label1 
      BackStyle       =   0  'Transparent
      Caption         =   "序 列 号"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   225
      Index           =   2
      Left            =   1860
      TabIndex        =   7
      Top             =   1470
      Width           =   1065
   End
   Begin VB.Label Label1 
      BackStyle       =   0  'Transparent
      Caption         =   "编    号"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   225
      Index           =   3
      Left            =   1860
      TabIndex        =   6
      Top             =   1920
      Width           =   1095
   End
   Begin VB.Image Image1 
      Height          =   330
      Left            =   5850
      Picture         =   "frmPHserialGL.frx":52AF2
      Top             =   210
      Width           =   330
   End
   Begin VB.Label Label1 
      BackStyle       =   0  'Transparent
      Caption         =   "喷绘序列管理"
      ForeColor       =   &H0000FFFF&
      Height          =   225
      Index           =   0
      Left            =   870
      TabIndex        =   2
      Top             =   300
      Width           =   1215
   End
End
Attribute VB_Name = "frmPHserialGL"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim env As rdoEnvironment
Dim cn As rdoConnection
Dim result As rdoResultset
Dim result1 As rdoResultset
Dim d_conn, sql As String
Dim hrowcount, hrowcount1 As Integer
Dim n As Integer
Dim jframe As New dframe
Private Function GetNextKey() As String
'Returns a new key value for each Node being added to the TreeView
'This algorithm is very simple and will limit you to adding a total of 999 nodes
'Each node needs a unique key. If you allow users to remove Nodes you can't use
'the Nodes count +1 as the key for a new node.

    Dim sNewKey As String
    Dim iHold As Integer
    Dim i As Integer
    On Error GoTo myerr
    'The next line will return error #35600 if there are no Nodes in the TreeView
    iHold = Val(frmPHJiTai.TreeView1.Nodes(1).Key)
    For i = 1 To frmPHJiTai.TreeView1.Nodes.Count
        If Val(frmPHJiTai.TreeView1.Nodes(i).Key) > iHold Then
            iHold = Val(frmPHJiTai.TreeView1.Nodes(i).Key)
        End If
    Next
    iHold = iHold + 1
    sNewKey = CStr(iHold) & "_"
    GetNextKey = sNewKey 'Return a unique key
    Exit Function
myerr:
    'Because the TreeView is empty return a 1 for the key of the first Node
    GetNextKey = "1_"
    Exit Function
End Function
Private Sub Form_Load()
   rgn1 = 0
   n = 0
   Dim Ma As Dat
   Show
   Open App.Path & "\publish.dat" For Random As #1 Len = Len(Ma)
   Do While Not EOF(1)
      n = n + 1
      Get #1, n, Ma
      If rgn1 = 0 Then rgn1 = CreateRectRgn(Ma.sx, Ma.sy, Ma.ex, Ma.ey)
      If rgn1 <> 0 Then
            rgn2 = CreateRectRgn(Ma.sx, Ma.sy, Ma.ex, Ma.ey)
            CombineRgn rgn1, rgn1, rgn2, 2
                  '释放系统资源
            DeleteObject rgn2
      End If
  Loop
'关闭文件
    Close #1
    SetWindowRgn hwnd, rgn1, True
    DeleteObject rgn1
    '''''''''
    On Error GoTo errmsg
'    Set env = rdoEnvironments(0)
'    env.CursorDriver = rdUseOdbc
'    d_conn = "uid=sa;pwd=;driver={SQL SERVER};SERVER=ntserver;database=phdatabase;"
'    Set cn = env.OpenConnection(dsname:="odbc_api_demo", Prompt:="rdodriverprompt", ReadOnly:=False, Connect:=d_conn)
    Text1.Text = GoodsTree
errmsg:
    If Err.Number <> 0 Then
       
    End If
End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = 1 Then
       mX = X
       mY = Y
    End If
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = 1 Then
       frmPHserialGL.Move frmPHserialGL.Left - mX + X, frmPHserialGL.Top - mY + Y
    End If
    Picture1.Cls
    Picture2.Cls
End Sub

Private Sub Image1_Click()
    Unload Me
End Sub

Private Sub Picture1_Click()
     Dim RecordCount As Integer
    Dim oindex As Integer
    Dim skey As String
    sql = "select  *  from  PHSerial  where  级别='" & Trim(Text1.Text) & "'  and  序列号='" & Trim(Text2.Text) & "'"
    Set result = cn.OpenResultset(sql, rdOpenDynamic, rdConcurRowVer)
    If result.RowCount <> 0 Then
        MsgBox "本序列已经存在...."
    Else
        
        sql = "insert into  PHSerial(级别,序列号,编号) values ('" & Trim(Text1.Text) & "','" & Trim(Text2.Text) & "'," & Val(Trim(Text3.Text)) & ")"
        Set result = cn.OpenResultset(sql, rdOpenDynamic, rdConcurRowVer)
        sql = "select * from PHSerial  where 级别='" & Trim(GoodsTree) & "'"
        Set result = cn.OpenResultset(sql, rdOpenDynamic, rdConcurRowVer)
        If result.RowCount <> 0 Then
           result.MoveLast
           RecordCount = result.RowCount
           result.MoveFirst
        End If
        skey = RecordCount & GetNextKey()
        oindex = frmPHJiTai.TreeView1.SelectedItem.Index
        If result.RowCount <> 0 Then
           
           Set frmPHJiTai.TreeView1.ImageList = frmPHJiTai.ImageList1
           Set Treesub = frmPHJiTai.TreeView1.Nodes.Add(oindex, tvwChild, skey, Trim(Text2.Text), 1)
           Treesub.Image = 1
           Treesub.EnsureVisible
        End If
    End If
End Sub

Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Picture2.Cls
    jframe.danum = 5
    jframe.rtop = 1
    jframe.rleft = 1
    jframe.rright = 80
    jframe.rbottom = 23
    jframe.ddrawc Picture1
End Sub

Private Sub Picture2_Click()
    Unload Me
End Sub

Private Sub Picture2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Picture1.Cls
    jframe.danum = 5
    jframe.rtop = 1
    jframe.rleft = 1
    jframe.rright = 80
    jframe.rbottom = 23
    jframe.ddrawc Picture2
End Sub

Private Sub Text2_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
       KeyAscii = 0
       SendKeys "{tab}"
    End If
End Sub