formmain.frm

本系统特为行业报价、订单、产品管理与客户关系管理所订制

         Caption         =   "皮肤一"
      End
      Begin VB.Menu Nskn2 
         Caption         =   "皮肤二"
      End
      Begin VB.Menu nskn3 
         Caption         =   "皮肤三"
      End
      Begin VB.Menu nskn4 
         Caption         =   "皮肤四"
      End
      Begin VB.Menu nskn5 
         Caption         =   "皮肤五"
      End
      Begin VB.Menu nskn6 
         Caption         =   "皮肤六"
      End
      Begin VB.Menu nskn7 
         Caption         =   "皮肤七"
      End
   End
   Begin VB.Menu jjmanage 
      Caption         =   "间距调整"
      Visible         =   0   'False
      Begin VB.Menu Savejj 
         Caption         =   "保存调整后的间距"
      End
      Begin VB.Menu MRjj2 
         Caption         =   "使用默认间距"
      End
   End
   Begin VB.Menu jjmanage2 
      Caption         =   "间距调整"
      Visible         =   0   'False
      Begin VB.Menu Savejj2 
         Caption         =   "保存调整后的间距"
      End
      Begin VB.Menu MRjj 
         Caption         =   "使用默认间距"
      End
      Begin VB.Menu TZRows 
         Caption         =   "调整显示表框行数"
      End
      Begin VB.Menu Seekhmx 
         Caption         =   "查看该客户消费明细"
      End
   End
   Begin VB.Menu formtj 
      Caption         =   "统计"
      Visible         =   0   'False
      Begin VB.Menu formtj1 
         Caption         =   "简单统计"
      End
      Begin VB.Menu formtj2 
         Caption         =   "销售统计表"
      End
   End
End
Attribute VB_Name = "formmain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'****************************************************************************
'人人为我，我为人人
'枕善居收藏整理
'发布日期：2008/05/10
'描    述：商品综合管理系统 Sql2000版
'网    站：http://www.Mndsoft.com/  (VB6源码博客)
'网    站：http://www.VbDnet.com/   (VB.NET源码博客,主要基于.NET2005)
'e-mail  ：[e-mail]
'e-mail  ：[e-mail]
'OICQ    ：88382850
'          如果您有新的好的代码别忘记给枕善居哦!
'****************************************************************************
Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Private Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long)
Private Declare Function lStrLen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As String) As Long

Dim DataByte() As Byte
Public Dw_Url As String
Dim StartTime As Date '连接服务器的时间
Dim UPI As Boolean

Public je As Integer '记忆菜单上次数值，实现数据传送
Dim AddNew As Boolean
Dim ADDSave As Boolean
Dim GEdit As Boolean
Dim Gdel As Boolean
Dim Showstr As String '显示错误字段
Public ncount As Double '记录条数
Public npage As Double '当前记录位置
Public nnum As Integer '数据总页数
Public numpage As Integer '数据当前页数
Dim IDKey(30) As Integer 'grid5每条数据的对应ID
Dim StrNumberID(15) As String '当前ID
Dim StrN As String '当前对应类型编码
Dim Grid5_Top As Double '记录当前grid5_top的值
Dim Grid5_Height As Double '记录当前grid5_top的值
Dim LoginU(18) As String '记录权限
Dim LMessage As String '不允许操作提示
Const SYSMONEYFORMAT As String = "#,###,###,###,##0.00"
Const MONEY_MAX_POS As Long = 15

Private Declare Function GetVolumeInformation& Lib "kernel32" _
    Alias "GetVolumeInformationA" (ByVal lpRootPathName _
    As String, ByVal pVolumeNameBuffer As String, ByVal _
    nVolumeNameSize As Long, lpVolumeSerialNumber As Long, _
    lpMaximumComponentLength As Long, lpFileSystemFlags As _
    Long, ByVal lpFileSystemNameBuffer As String, ByVal _
    nFileSystemNameSize As Long)
        Const MAX_FILENAME_LEN = 256
Public Function SerNum(Drive$) As Long '获取硬盘序列号
    Dim No&, s As String * MAX_FILENAME_LEN
    Call GetVolumeInformation(Drive + ":\", s, MAX_FILENAME_LEN, _
    No, 0&, 0&, s, MAX_FILENAME_LEN)
    SerNum = No
End Function

Private Sub asPopup1_Click(Cancel As Boolean)
 If LoginU(13) <> "1" Then
 MsgBox LMessage, vbInformation, "提示"
 Exit Sub
End If
 Grid2_5_1
 TKTable = "C_Message"
 CMessage '执行表格信息
 yxsql = "select * from " & TKTable
 SeeGrid1
End Sub


Private Sub asPopup10_Click(Cancel As Boolean)
 If LoginU(13) <> "1" Then
 MsgBox LMessage, vbInformation, "提示"
 Exit Sub
End If
CPManage.Show
End Sub

Private Sub asPopup11_Click(Cancel As Boolean)
If UKeyStr <> KeyStr And KeyStr <> "" Then
MsgBox "只有注册用户才可使用!", vbInformation, "提示"
Exit Sub
End If
If LoginU(17) = "1" Then
Lfrom.Show
Else
MsgBox LMessage, vbInformation, "提示"
End If
End Sub

Private Sub asPopup12_Click(Cancel As Boolean)
 If LoginU(9) <> "1" Then
 MsgBox LMessage, vbInformation, "提示"
 Exit Sub
End If
 Grid2_5_1
 TKTable = "P_Message"
 PMessage '执行表格信息
 yxsql = "select * from " & TKTable
 SeeGrid1
'Formsend.Show
End Sub

Private Sub asPopup13_Click(Cancel As Boolean)
If LoginU(6) <> "1" Then
 MsgBox LMessage, vbInformation, "提示"
 Exit Sub
End If
Grid1.Cell(1, 4).Text = "" '为客户记录统计作准备
Grid1.Refresh
TKTable = "XS_dj"
yxsql = "select * from xs_dj order by  id desc"
XSNote
Grid2_5
End Sub
Private Sub Grid2_5_1() 'grid2-grid5的控件移动变化
Grid5.Move 0, Grid5_Top, Pcr2.ScaleWidth, Grid5_Height
Pcrmenu.Move 0, Pcrmenu1.Top - Pcrmenu.Height, Pcr2.ScaleWidth, Pcrmenu.Height
Grid2.Move 0, Grid2.Top, Pcr2.ScaleWidth, Pcrmenu.Top - Grid2.Top
Grid2.Visible = True
Grid5.Visible = False
Grid1.Visible = False
Image1.Visible = True
Grid1.Column(2).Locked = True
Grid2.ReadOnly = False
SeeGrid1
AddNew = False
GEdit = True
Gdel = True
End Sub
Private Sub Grid2_5() 'grid2-grid5的控件移动变化
If Grid5_Top > 0 Then
Grid5.Move 0, Grid5_Top, Pcr2.ScaleWidth, Grid5_Height
End If
Pcrmenu.Move 0, Grid5.Top - Pcrmenu.Height, Pcr2.ScaleWidth, Pcrmenu.Height
Grid2.Move 0, Grid2.Top, Pcr2.ScaleWidth, Pcrmenu.Top - Grid2.Top
Grid2.Visible = True
Grid5.Visible = True
Grid1.Visible = True
Image1.Visible = False
Grid1.Column(2).Locked = True
SeeGrid1
AddNew = False
GEdit = True
Gdel = True
End Sub

Private Sub asPopup14_Click(Cancel As Boolean) '报警显示
bjshow.Show
End Sub

Private Sub asPopup15_Click(Cancel As Boolean)
If LoginU(7) <> "1" Then
 MsgBox LMessage, vbInformation, "提示"
 Exit Sub
End If
SendDH = ""
form2.Show
End Sub

Private Sub asPopup2_Click(Cancel As Boolean)
On Error GoTo finish:
If LoginU(18) <> "1" Then
 MsgBox LMessage, vbInformation, "提示"
 Exit Sub
End If
cnn.Close
Dim strtargetfile As String
Dim strDestination As String
OpenDialog.Filter = "备份文件(*.bak)|*.bak"
OpenDialog.ShowOpen
If OpenDialog.FileName <> "" And OpenDialog.CancelError = False Then
strtargetfile = OpenDialog.FileName
strDestination = App.Path & "\base.mdb"
FileCopy strtargetfile, strDestination
tkOpenAccessDB App.Path & "\base.mdb"
MsgBox "已成功还原!", vbInformation, "提示"
Else
tkOpenAccessDB App.Path & "\base.mdb"
End If
Exit Sub
finish:
MsgBox Err.Description
End Sub

Private Sub asPopup3_Click(Cancel As Boolean)
Set Qy1 = Nothing
Set Qy2 = Nothing
Set Qy3 = Nothing
cnn.Close
End
End Sub


Private Sub asPopup4_Click(Cancel As Boolean)
If LoginU(3) <> "1" Then
 MsgBox LMessage, vbInformation, "提示"
 Exit Sub
End If
TKTable = "XS_dj"
XSNote
NEWADDGrid
If Grid5_Top = 0 Then
Grid5_Top = Grid5.Top
Grid5_Height = Grid5.Height
End If
Grid2_5
AddNew = True
Pcrmenu.Move 0, Pcrmenu1.Top - Pcrmenu.Height, Pcr2.ScaleWidth, Pcrmenu.Height
Grid2.Visible = False
Grid5.Move 0, Grid2.Top, Pcr2.ScaleWidth, Pcrmenu.Top - Grid2.Top
Grid1.Cell(1, 10).Text = "0.00"
Grid1.Cell(1, 12).Text = "100"
Grid1.Cell(1, 14).Text = "0.00"
End Sub

Private Sub asPopup5_Click(Cancel As Boolean)
 If LoginU(14) <> "1" Then
 MsgBox LMessage, vbInformation, "提示"
 Exit Sub
End If
 Grid2_5_1
TKTable = "C_Message"
CMessage
NEWADDGrid
End Sub

Private Sub asPopup6_Click(Cancel As Boolean)
On Error GoTo finish:
If LoginU(18) <> "1" Then
 MsgBox LMessage, vbInformation, "提示"
 Exit Sub
End If
Dim strSource, strDestination As String
cnn.Close
strSource = App.Path & "\base.mdb"
strDestination = App.Path & "\" & Date & "-" & Hour(Time) & "-" & Minute(Time) & "-" & Second(Time) & ".bak"
FileCopy strSource, strDestination
tkOpenAccessDB App.Path & "\base.mdb"
MsgBox "备份成功!路径(" & strDestination & ")", vbInformation, "提示"
Exit Sub
finish:
MsgBox Err.Description
tkOpenAccessDB App.Path & "\base.mdb"
End Sub

Private Sub asPopup7_Click(Cancel As Boolean)
Formsd1.Show '类型设置
End Sub

Private Sub asPopup8_Click(Cancel As Boolean)
If LoginU(10) <> "1" Then
 MsgBox LMessage, vbInformation, "提示"
 Exit Sub
End If
Grid2_5_1
TKTable = "P_Message"
PMessage
NEWADDGrid
'OPTForm.Show 1
End Sub

Private Sub asPopup9_Click(Cancel As Boolean)
If UKeyStr <> KeyStr And KeyStr <> "" Then
MsgBox "只有注册用户才可使用!", vbInformation, "提示"
Exit Sub
End If
NBmanage.Show
End Sub

Private Sub Cancel_Click()
Picture2.Visible = False
End Sub

Private Sub CMDFind_Click()
On Error GoTo finish '防错代码，防止用户组织语句的错误或其它不可预见的错误发生
If Grid4.Cell(1, 1).Text <> "" And Grid4.Cell(2, 1).Text <> "" And Grid4.Cell(3, 1).Text <> "" And Grid4.Cell(4, 1).Text <> "" Then
    If Grid4.Cell(1, 1).Text = "精确查询" Then
      Select Case Grid4.Cell(2, 1).Text '处理数值型的查询组织语句
      Case "客户名称"
      If TKTable = "XS_dj" Then
      yxsql = "select * from xs_dj where coname='" & Grid4.Cell(4, 1).Text & "'"
      Else
      yxsql = "select * from c_message where coname='" & Grid4.Cell(4, 1).Text & "'"
      End If
     End Select
    Else
     Select Case Grid4.Cell(2, 1).Text '处理数值型的查询组织语句
      Case "客户名称"
       If TKTable = "XS_dj" Then
        yxsql = "select * from XS_dj where coname like '%" & Grid4.Cell(4, 1).Text & "%'"
       Else
        yxsql = "select * from c_message where coname like '%" & Grid4.Cell(4, 1).Text & "%'"
       End If
     End Select
    End If
  If TKTable = "XS_dj" Then
   Grid2_5
   Table = "XS_dj"
   XSNote '执行表格信息
   SeeGrid1
  Else
  If yxsql <> "" Then
   Grid2_5_1
   Table = "C_Message"