formmain.frm

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

   CMessage '执行表格信息
   SeeGrid1
  End If
  End If
Else
MsgBox "查询时关键组成部分不可以出现空格！"
End If
Exit Sub
finish:
  MsgBox Err.Description
End Sub

Private Sub Command_menu_Click(Index As Integer)
cmove 4, Index
End Sub

Private Sub Command1_Click()
TJPcr.Visible = False
TJLabel.Caption = ""
End Sub


Private Sub Form_Load()
On Error GoTo finish:
Skn1.LoadSkin App.Path & sknPname
Skn1.ApplySkinByName hWnd, "窗体"
Skn1.ApplySkin hWnd
Me.Caption = "商品综合管理系统单机版 版本号(" & Mid(VersionN, 1, 4) & ")"
Picture1.Picture = LoadPicture(App.Path & "\bg1.jpg")
Set Qy1 = cnn.Execute("select id from numberm where id='1'") '载入编号
If Qy1.EOF = True Then
Set Qy1 = cnn.Execute("insert into numberm values('XS','000001','999999','000001','1')")
End If
Set Qy1 = cnn.Execute("select id from numberm where id='2'") '载入编号
If Qy1.EOF = True Then
Set Qy1 = cnn.Execute("insert into numberm values('KH','000001','999999','000001','2')")
End If
Set Qy1 = cnn.Execute("select id from numberm where id='3'") '载入编号
If Qy1.EOF = True Then
Set Qy1 = cnn.Execute("insert into numberm values('CP','000001','999999','000001','3')")
End If
Set Qy1 = cnn.Execute("select id from numberm where id='4'") '载入编号
If Qy1.EOF = True Then
Set Qy1 = cnn.Execute("insert into numberm values('BJ','000001','999999','000001','4')")
End If
For i = 0 To 4 '菜单背景设置
Picmenu_qg(i).BackColor = RGB(73, 161, 218) 'RGB(240, 250, 255)
Next

If Dir(App.Path & "\update1.exe", vbNormal) <> "" Then
  FileCopy App.Path & "\update1.exe", App.Path & "\update.exe"
End If

Grid1.OpenFile (App.Path & "\djcell.cel")

With Grid2
 .OpenFile (App.Path & "\XScell.cel")
End With

With Grid4
    .AutoRedraw = False
    .AllowUserResizing = False '是否可调整行和例
    .DisplayFocusRect = False '当前活动单元格是否显示一个虚框
    .ExtendLastCol = True '是否让表格充满控件
    .Appearance = Flat '选择绘图风格，平面还是3D
    .FixedRowColStyle = Flat '固定行/列的样式
    .ScrollBarStyle = Flat '滚动条的样式

    .DefaultFont.Name = "Tahoma"
    .DefaultFont.Size = GridSize
    .RowHeight(0) = 0
 .Column(0).Alignment = cellRightCenter
 .Column(1).Alignment = cellCenterCenter
 .Column(0).Width = 70
 .Cell(1, 0).Text = "查询模式：" '将表格内添入固定内容
 .Cell(2, 0).Text = "查询名称："
 .Cell(3, 0).Text = "条 件："
 .Cell(4, 0).Text = "查询内容："
 .Cell(1, 1).CellType = cellComboBox
 .Cell(2, 1).CellType = cellComboBox
 .Cell(3, 1).CellType = cellComboBox
 .AutoRedraw = True
 .Refresh
End With
With Grid5
 .OpenFile (App.Path & "\xsjlcell.cel")
 Dim buff As String
 buff = String(255, 0)
 ret = GetPrivateProfileString("XS_Note", "XS_Note", "", buff, 256, App.Path & "\JX.ini")
 If ret = 0 Then
 .Column(0).Width = 30
 .Column(1).Width = 75
 .Column(2).Width = 80
 .Column(3).Width = 70
 .Column(4).Width = 70
 .Column(5).Width = 50
 .Column(6).Width = 60
 .Column(7).Width = 65
 .Column(8).Width = 80
 Else
  Text1.Text = buff
  Dim TXJX() As String
  TXJX = Split(Text1.Text, ";")
  For i = 0 To UBound(TXJX)
   .Column(i).Width = TXJX(i)
  Next
 End If
 .AutoRedraw = True
 .Refresh
End With
strtargetfile = App.Path & "\key.k"
If Dir(strtargetfile, vbNormal) <> "" Then
filesize = FileLen(strtargetfile)
KeyStr = Space(filesize)
Open strtargetfile For Binary As #1
Get #1, , KeyStr
KeyStr = ""
Close #1
KEY_YZ
Else
Form1.Show 1
End If
LUManage
Exit Sub
finish:
End Sub
Private Sub LUManage() '权限管理
 LMessage = "无此操作权限,请与管理员联系!"
 Set Qy1 = cnn.Execute("select * from userm where un='" & LoginAdmin & "'")
 For i = 3 To Qy1.Fields.Count - 1
  LoginU(i) = Qy1.Fields(i)
 Next
End Sub
Private Sub cmove(s As Integer, i As Integer) '菜单智能移动函数代码
Dim j As Integer
Dim X, Y, z, x1, y1 As Integer
X = s
Y = s
z = s
x1 = s
j = 0
Do While s > 0
   If je > i Then
    Do While X > i
      Do While Y >= X
      j = j + 360
      Y = Y - 1
      Loop
      Command_menu(X).Top = Picmenu_bg.ScaleHeight - j
      X = X - 1
    Loop
    Else
    '-----------------向上代码
     For X = 0 To i
       For Y = 0 To X
       j = j + 360
       Next
       Command_menu(X).Top = j - 360
       j = 0
     Next
    End If
  s = s - 1
        For y1 = 0 To x1
      If y1 = i Then
       Picmenu_qg(y1).Visible = True
       Picmenu_qg(y1).Top = Command_menu(y1).Top + Command_menu(y1).Height
       If y1 <> z Then
       Picmenu_qg(y1).Height = Command_menu(y1 + 1).Top - Picmenu_qg(y1).Top
       Else
       Picmenu_qg(y1).Height = Picmenu_bg.ScaleHeight - Command_menu(y1).Top - Command_menu(y1).Height
       End If
      Else
       Picmenu_qg(y1).Visible = False
      End If
    Next
Loop
je = i
End Sub


Private Sub Form_Resize()
If Me.WindowState <> 1 Then
Me.WindowState = 2
Picture1.Width = Me.ScaleWidth
Label9.Top = Picture1.ScaleHeight - Label9.Height - 20
Label9.Left = Picture1.ScaleWidth - Label9.Width - 40
Label11.Top = Label9.Top
Label11.Left = Picture1.ScaleWidth - Label9.Width - Label11.Width - 200
Label1.Top = Label9.Top
Label1.Left = Label11.Left - Label1.Width - 200
Label4.Top = Label9.Top
Label4.Left = Label1.Left - Label4.Width - 200
Label10.Top = Label9.Top
Label10.Left = Label4.Left - Label10.Width - 200
Label5.Top = Label9.Top
Label5.Left = Label10.Left - Label5.Width - 200

Picmenu_bg.Top = Picture1.Height + Picture1.Top
Picmenu_bg.Height = Me.ScaleHeight - Picmenu_bg.Top '设定菜单页的高度
je = 4 '此处je变量主要作用于类QQ菜单的使用，这里自动设定记忆上一次的使用按钮
cmove 4, 0 '使菜单自选为第一菜单
Pcr2.BackColor = RGB(94, 147, 182)
'Picture2.BackColor = RGB(94, 147, 182)
Pcrmenu.BackColor = RGB(240, 250, 255)
Pcr2.Move 1720, Picture1.Top + Picture1.Height - 30, Me.ScaleWidth - 1683, Me.ScaleHeight - Picture1.Top - Picture1.Height + 30
Pcrmenu.Move 0, Pcrmenu.Height, Pcr2.ScaleWidth, Pcrmenu.Height
Grid1.Left = 0
Grid1.Width = Pcr2.ScaleWidth
Grid1.Top = 0
Image1.Move Grid1.Left, Grid1.Top, Grid1.Width, Grid1.Height
Grid2.Move 0, Grid1.Top + Grid1.Height + 20, Pcr2.ScaleWidth
Pcrmenu.Move 0, Grid2.Top + Grid2.Height, Pcr2.ScaleWidth, Pcrmenu.Height
Pcrmenu1.Move 0, Pcr2.ScaleHeight - Pcrmenu1.Height, Pcr2.ScaleWidth, Pcrmenu1.Height
Image2.Move 0, 0, Pcrmenu1.Width, Pcrmenu1.Height
If Grid5.Visible = True Then '防止最小化错误
AddNew = False
GEdit = False
Gdel = False
Grid2.Visible = True
Grid5.Move 0, Pcrmenu.Top + Pcrmenu.Height + 20, Pcr2.ScaleWidth, Pcrmenu1.Top - Pcrmenu.Top - Pcrmenu.Height - 20
Grid5_Top = Grid5.Top
Grid5_Height = Grid5.Height
End If
Toolbar1.Left = 0
Toolbar1.Width = Pcrmenu.ScaleWidth
Label2.Width = Pcrmenu1.ScaleWidth / 3
Label3.Left = Label2.Left + Label2.Width
Label3.Width = Pcrmenu1.ScaleWidth - Label3.Left
TJPcr.Move (Pcr2.Width - TJPcr.Width) / 2, (Pcr2.Height - TJPcr.Height) / 2, TJPcr.Width, TJPcr.Height
Picture2.Move Pcrmenu.ScaleWidth - Picture2.Width, Pcrmenu1.Top - Picture2.Height, Picture2.Width, Picture2.Height
PcrRows.Move (Pcr2.Width - PcrRows.Width) / 2, (Pcr2.Height - PcrRows.Height) / 2, PcrRows.Width, PcrRows.Height
UPPic.Move (Pcr2.Width - UPPic.Width) / 2, (Pcr2.Height - UPPic.Height) / 2, UPPic.Width, UPPic.Height
End If
End Sub

Private Sub NEWADDGrid()
            AddNew = True
            GEdit = False
            Gdel = False
            With Grid1
               .Cell(1, 2).Text = ""
               .Cell(1, 4).Text = ""
               If ChKQY.Value <> 1 Then
               .Cell(1, 6).Text = ""
               .Cell(1, 8).Text = ""
               .Cell(1, 10).Text = ""
               .Cell(1, 12).Text = ""
               .Cell(1, 14).Text = "0"
               End If
               .Column(2).Locked = False
            End With
            Grid2.Rows = 16
            Grid2.Column(1).Locked = False
            Grid2.Range(1, 1, Grid2.Rows - 1, Grid2.Cols - 1).ClearText
            
            '获取编号
            If ChKNumber.Value = 1 Then
             Dim StrA As String
             Dim StrB As String
             Dim StrS As String
             Dim StrN As String
             Dim WStr As String
             Select Case TKTable
              Case "XS_dj"
               StrN = "1"
                Grid5.Range(1, 1, Grid5.Rows - 1, Grid5.Cols - 1).ClearText
                For i = 1 To Grid5.Rows - 1 '将数量清0
                 Grid5.Cell(i, 5).Text = "0"
                 Grid5.Cell(i, 7).Text = "0"
                 Grid5.Cell(i, 8).Text = "0"
                 Grid5.Column(8).Locked = True
                Next

              Case "P_Message"
               StrN = "3"
                For i = 1 To Grid2.Rows - 1
                  Grid2.Cell(i, 5).Text = "0"
                  Grid2.Cell(i, 7).Text = "0"
                  Grid2.Cell(i, 8).Text = "0"
                  Grid2.Cell(i, 9).Text = "0"
                  Grid2.Cell(i, 10).Text = "0"
                Next
              Case "C_Message"
               StrN = "2"
             End Select
             Set Qy1 = cnn.Execute("select * from numberm where id='" & StrN & "'")
             If Qy1.EOF = False Then
              StrA = Qy1.Fields(3)
              If StrN <> "1" Then '当不等于订单录入的时候
              For i = 1 To Grid2.Rows - 1
              StrB = Format(StrA + 1, "#")
              StrS = Mid(StrA, 1, Len(StrA) - Len(StrB))
              StrNumberID(i) = StrS & StrB '保留为全局变量
              Set Qy2 = cnn.Execute("select * from " & TKTable & " where id='" & Qy1.Fields(0) & StrNumberID(i) & "'")
              If Qy2.EOF = True Then
              Grid2.Cell(i, 1).Text = Qy1.Fields(0) & StrNumberID(i)
              Else
              i = i - 1
              End If
              StrA = StrNumberID(i)
              Next
              Else
              For i = 1 To Grid1.Rows - 1
              StrB = Format(StrA + 1, "#")
              StrS = Mid(StrA, 1, Len(StrA) - Len(StrB))
              StrNumberID(1) = StrS & StrB '保留为全局变量
              Set Qy2 = cnn.Execute("select * from " & TKTable & " where id='" & Qy1.Fields(0) & StrNumberID(1) & "'")
              If Qy2.EOF = True Then
              Grid1.Cell(1, 2).Text = Qy1.Fields(0) & StrNumberID(1)
              Else
              i = i - 1
              End If
              StrA = StrNumberID(1)
              Next
              End If
             End If
            End If
            Grid1.Refresh

End Sub

Private Sub formtj1_Click()
On Error GoTo finish:
If TJPcr.Visible = True Then
TJPcr.Visible = False
Exit Sub
End If
Set Qy1 = cnn.Execute("select count(zmoney) from XS_dj where jdate='" & Date & "'")
If Qy1.Fields(0) > 0 Then
Set Qy1 = cnn.Execute("select sum(zmoney) from XS_dj where jdate='" & Date & "'")
TJLabel.Caption = "本日累计销售金额：" & Qy1.Fields(0) & " 元" & vbCrLf
Else
TJLabel.Caption = "本日累计销售金额：0.00 元" & vbCrLf
End If

Set Qy1 = cnn.Execute("select count(*) from XS_dj,xs_note where id=xs_note.pid and jdate='" & Date & "'")
If Qy1.Fields(0) > 0 Then
Set Qy1 = cnn.Execute("select sum(num) from XS_dj,xs_note where id=xs_note.pid and jdate='" & Date & "'")
TJLabel.Caption = TJLabel.Caption & "本日累计销售商品：" & Qy1.Fields(0) & " 件" & vbCrLf
Else
TJLabel.Caption = TJLabel.Caption & "本日累计销售商品：0 件" & vbCrLf
End If

TJLabel.Caption = TJLabel.Caption & vbCrLf

Set Qy1 = cnn.Execute("select sum(zmoney) from XS_dj")
If Qy1.Fields(0) > 0 Then
Set Qy1 = cnn.Execute("select zmoney,jdate from XS_dj")
Dim summoney As Double
Do While Not Qy1.EOF
  If Year(Qy1.Fields(1)) = Year(Date) And Month(Qy1.Fields(1)) = Month(Date) Then
   summoney = summoney + Qy1.Fields(0)
  End If
  Qy1.MoveNext
Loop
TJLabel.Caption = TJLabel.Caption & "本月累计销售商品：" & summoney & " 元" & vbCrLf
Else
TJLabel.Caption = TJLabel.Caption & "本月累计销售商品：0 元" & vbCrLf
End If

Set Qy1 = cnn.Execute("select count(*) from XS_dj,xs_note")
Dim snum As Double
If Qy1.Fields(0) > 0 Then
Set Qy1 = cnn.Execute("select id,jdate from XS_dj")
Do While Not Qy1.EOF
  If Year(Qy1.Fields(1)) = Year(Date) And Month(Qy1.Fields(1)) = Month(Date) Then
   Set Qy3 = cnn.Execute("s