form1.frm

lgxgrid控件lgxgrid控件lgxgrid控件lgxgrid控件lgxgrid控件lgxgrid控件

Private Sub lgxgrid1_ExitEditAll(ByVal Row As Long, ByVal List As Long)
'MsgBox (row & "  " & list)
End Sub

Private Sub lgxgrid1_GotoNewRow(ByVal oldRow As Long, oldList As Long, ByVal newRow As Long, ByVal newList As Long)
'MsgBox (oldRow & "  " & oldList & "  " & newRow & "  " & newList)
End Sub


Private Sub lgxgrid1_HChange(ByVal value As Long)
lgxgrid2.SetLists 0, 1, 100, False
lgxgrid2.Visible = False
End Sub

Private Sub lgxgrid1_IntoEdit(ByVal Olddata As String, ByVal Row As Long, ByVal List As Long)
If List = 3 Then
  lgxgrid1.ComAdd 3, "text", "女"
  'lgxgrid1.ComboClear 5
End If
End Sub

Private Sub lgxgrid11_KeyChange(ByVal Data As String, ByVal Mode As Boolean, ByVal KeyCode As Integer, ByVal Row As Long, ByVal List As Long, ByVal x As Single, ByVal y As Single)
  showok = False
  Dim i As Long
  Dim pm As String
  Dim Findok As Boolean
  If (Mode = True And (oldRow <> lgxgrid1.Nrow Or oldList <> lgxgrid1.Nlist) And KeyCode <> 13) Or (Mode = True And lgxgrid2.Visible = False And KeyCode <> 13) Then
    lgxgrid2.Visible = False
    '显示数据库的数据
    Call DataSource(SetSql("select * from 产品表"))
    '调整子表的显示位置
    lgxgrid2.Left = Me.ScaleX(x, 3, 1) + lgxgrid1.Left + 50
    lgxgrid2.Top = Me.ScaleY(y, 3, 1) + lgxgrid1.Top + 50
    If (lgxgrid2.Top + lgxgrid2.Height) - Me.ScaleHeight > 0 Then
      lgxgrid2.Top = lgxgrid2.Top - lgxgrid2.Height - lgxgrid1.RowHeight - 50
    End If
    If (lgxgrid2.Left + lgxgrid2.Width) - Me.ScaleWidth > 0 Then
      lgxgrid2.Left = lgxgrid2.Left - lgxgrid2.Width
    End If
    lgxgrid2.OrderList 1, lgxgrid2.rows, 1, SortAscending, CharacterMode
    lgxgrid2.Visible = True
  End If
  If lgxgrid2.Visible = True Then
   '查找
   For i = 1 To lgxgrid2.rows
     If InStr(lgxgrid2.GetData(i, 1), Data) = 1 And Data <> "" Then
       lgxgrid2.SetNowGrid i, 1
       If lgxgrid2.GetData(i, 1) = Data Then
         pm = lgxgrid2.GetData(lgxgrid2.Nrow, 2)
         lgxgrid1.SetData Row, 2, pm
         pm = lgxgrid2.GetData(lgxgrid2.Nrow, 3)
         lgxgrid1.SetData Row, 4, pm
       End If
       Findok = True
       Exit For
     End If
   Next
   If Findok = False Then
     lgxgrid1.SetData lgxgrid1.Nrow, 2, ""
     lgxgrid1.SetData lgxgrid1.Nrow, 4, ""
   End If
  End If
  If KeyCode = 40 And Mode = True Then '选择
    lgxgrid2.SetFocus
    If lgxgrid2.Nrow > 0 Then
      lgxgrid2.SetArea lgxgrid2.Nrow, 1, lgxgrid2.Nrow, lgxgrid2.lists
    Else
      lgxgrid2.SetArea 1, 1, 1, lgxgrid2.lists
      pm = lgxgrid2.GetData(lgxgrid2.Nrow, 1)
      lgxgrid1.SetData Row, 1, pm
      pm = lgxgrid2.GetData(lgxgrid2.Nrow, 2)
      lgxgrid1.SetData Row, 2, pm
      pm = lgxgrid2.GetData(lgxgrid2.Nrow, 3)
      lgxgrid1.SetData Row, 4, pm
    End If
  End If
  
  
  If KeyCode = 13 And Mode = True Then  '快速输入
   pm = lgxgrid2.GetData(lgxgrid2.Nrow, 1)
   lgxgrid1.SetData Row, 1, pm
   pm = lgxgrid2.GetData(lgxgrid2.Nrow, 2)
   lgxgrid1.SetData Row, 2, pm
   pm = lgxgrid2.GetData(lgxgrid2.Nrow, 3)
   lgxgrid1.SetData Row, 4, pm
  End If
  
  showok = True '可以执行值改变事件了
  oldRow = lgxgrid1.Nrow
  oldList = lgxgrid1.Nlist
End Sub

Private Sub lgxgrid1_KeyPress(ByVal KeyAscii As Integer)
  If KeyAscii >= 38 And KeyAscii <= 41 Then
      'lgxgrid1.SetArea lgxgrid1.Nrow, 1, lgxgrid1.Nrow, lgxgrid1.lists
  End If

End Sub

Private Sub lgxgrid1_LwChang(ByVal Lid As Long, ByVal Lw As Long)
'MsgBox (Lid & "  " & Lw)
End Sub

Private Sub lgxgrid1_PrintOut(PObj As Object, ByVal PYms As Long)
PObj.CurrentX = 0
PObj.CurrentY = 0
PObj.Print "sdfjskdjf"
End Sub

Private Sub lgxgrid1_OutFunctionAdd(ByVal FuncName As String, FuncData() As Variant)
  Select Case LCase(FuncName)
    Case "getx2":
       lgxgrid1.ReturnData = GetX2(CDbl(FuncData(0)), CDbl(FuncData(1)))
    Case "getx3":
       lgxgrid1.ReturnData = GetX3(CDbl(FuncData(0)), CDbl(FuncData(1)))
  End Select
End Sub
Private Function GetX2(x As Double, y As Double) As Double
  GetX2 = x ^ 2 + y ^ 2
End Function
Private Function GetX3(x As Double, y As Double) As Double
  GetX3 = x ^ 3 + y ^ 3
End Function

Private Sub lgxgrid1_SonTableClick(ByVal Row As Long, ByVal List As Long, ByVal x As Single, ByVal y As Single)
  lgxgrid2.Visible = False
  lgxgrid2.SetLists 0, 1, 10, False
  lgxgrid2.SetLists 10, 1, 500, False
  lgxgrid2.Left = Me.ScaleX(x, 3, 1) + lgxgrid1.Left
  lgxgrid2.Top = Me.ScaleY(y, 3, 1) + lgxgrid1.Top
  If (lgxgrid2.Top + lgxgrid2.Height) - Me.ScaleHeight > 0 Then
    lgxgrid2.Top = lgxgrid2.Top - lgxgrid2.Height - lgxgrid1.RowHeight
  End If
  If (lgxgrid2.Left + lgxgrid2.Width) - Me.ScaleWidth > 0 Then
    lgxgrid2.Left = Me.ScaleX(x, 3, 1) - lgxgrid2.Width
  End If
  lgxgrid2.SetdRowsx 20
  lgxgrid2.Refurbish
  For i = 1 To 20
   For j = 1 To 10
     lgxgrid2.SetData i, j, i
   Next
  Next
  lgxgrid2.Visible = True
End Sub

Private Sub lgxgrid1_VChange(ByVal value As Long)
lgxgrid2.SetLists 0, 1, 100, False
lgxgrid2.Visible = False
End Sub

Private Sub lgxgrid2_Click()
Dim pm As String
'lgxgrid2.SetArea lgxgrid2.Nrow, 1, lgxgrid2.Nrow, lgxgrid2.lists
pm = lgxgrid2.GetData(lgxgrid2.Nrow, 1)
lgxgrid1.SetData lgxgrid1.Nrow, 1, pm
pm = lgxgrid2.GetData(lgxgrid2.Nrow, 2)
lgxgrid1.SetData lgxgrid1.Nrow, 2, pm
pm = lgxgrid2.GetData(lgxgrid2.Nrow, 3)
lgxgrid1.SetData lgxgrid1.Nrow, 4, pm
End Sub


Private Sub lgxgrid21_DataChang(ByVal hid As Long, ByVal Lid As Long, ByVal Olddata As String, ByVal NewData As String)
'添加或修改数据
Dim xh As String '品名规格

On Error Resume Next  '错误处理

'判断数据是否完整
Dim NullTxt As Boolean
Dim i As Integer
For i = 1 To lgxgrid2.lists
  If lgxgrid2.GetData(hid, i) = "" Then NullTxt = True
Next
If NullTxt = False And showok = True Then '数据是完整的,执行相关的操作
  showok = False
  Dim Addyes As Boolean '判断是添加还是修改
  If Lid = 1 Then
    xh = Olddata
  Else
    xh = lgxgrid2.GetData(hid, 1)
  End If
  If SetSql("select count(品名规格) from 产品表 where 品名规格='" & xh & "'").Fields(0) = 0 Then
     Addyes = True '添加
  Else
     Addyes = False '修改
  End If

  Dim sqltxt 'sql表达式
  If Addyes = True Then '添加数据
    Err.Clear
    sqltxt = "INSERT INTO 产品表 ( 品名规格,单位,单价)"
    sqltxt = sqltxt & " values('" & lgxgrid2.GetData(hid, 1) & "',"
    sqltxt = sqltxt & "'" & lgxgrid2.GetData(hid, 2) & "',"
    sqltxt = sqltxt & lgxgrid2.GetData(hid, 3) & ")"
    Mysjk.Execute (sqltxt)
    If Err.Number <> 0 Then
      MsgBox ("你输入的数据存在错误,无法添加数据")
      lgxgrid2.SetData hid, Lid, ""
    End If
  Else '修改数据
    Err.Clear
    sqltxt = "UPDATE 产品表 SET 品名规格='" & lgxgrid2.GetData(hid, 1) & "',"
    sqltxt = sqltxt & "单位='" & lgxgrid2.GetData(hid, 2) & "',"
    sqltxt = sqltxt & "单价=" & lgxgrid2.GetData(hid, 3)
    sqltxt = sqltxt & " where 品名规格='" & xh & "'"
    Mysjk.Execute (sqltxt)
    If Err.Number <> 0 Then
      MsgBox ("你输入的数据存在错误,无法修改数据")
      lgxgrid2.SetData hid, Lid, Olddata
    End If
  End If
Else
  If Olddata <> "" And NewData = "" And showok = True And Chno = False Then
    lgxgrid2.SetData hid, Lid, Olddata
    MsgBox ("输入的数据不允许是空值。")
  End If
End If
showok = True
End Sub


Private Sub lgxgrid2_DragDropXY(ByVal x As Single, ByVal y As Single)
lgxgrid2.Left = lgxgrid2.Left + x
lgxgrid2.Top = lgxgrid2.Top + y
End Sub

Private Sub lgxgrid2_GotFocus()
'lgxgrid2.SetArea lgxgrid2.Nrow, 1, lgxgrid2.Nrow, lgxgrid2.lists
End Sub


Private Sub lgxgrid2_KeyPress(ByVal KeyAscii As Integer)
If KeyAscii >= 38 And KeyAscii <= 41 Then
 Dim pm As String
 'lgxgrid2.SetArea lgxgrid2.Nrow, 1, lgxgrid2.Nrow, lgxgrid2.lists
 pm = lgxgrid2.GetData(lgxgrid2.Nrow, 1)
 lgxgrid1.SetData lgxgrid1.Nrow, 1, pm
 pm = lgxgrid2.GetData(lgxgrid2.Nrow, 2)
 lgxgrid1.SetData lgxgrid1.Nrow, 2, pm
 pm = lgxgrid2.GetData(lgxgrid2.Nrow, 3)
 lgxgrid1.SetData lgxgrid1.Nrow, 4, pm
End If

If KeyAscii = 46 Then '删除数据
 Chno = True
 Dim sqltxt As String 'sql表达式
 Dim xh As String '品名规格
 Dim Delyes As Integer
 xh = lgxgrid2.GetData(lgxgrid2.Nrow, 1)
 Delyes = MsgBox("你确实要删除品名为“" & xh & "”的产品数据吗？", 1)
 If Delyes = 1 Then
   sqltxt = "delete * from 产品表 where 品名规格='" & xh & "'"
   Mysjk.Execute (sqltxt)
   lgxgrid2.DelRow lgxgrid2.Nrow
 End If
 Chno = False
End If

If KeyAscii = 13 Then
  'lgxgrid2.Visible = False
  lgxgrid1.InEdit lgxgrid1.Nrow, 3
End If

End Sub

Private Sub Mt_Click()
lgxgrid1.MailTo "[e-mail]", "我要注册", "我的注册号是"
End Sub

Private Sub Pfunc_Click()
  lgxgrid1.PlasterFunc
End Sub

Private Sub Text2_Change()
'Text2.LinkItem
End Sub


Private Sub setFunc_Click()
  lgxgrid1.setFunc lgxgrid1.Nrow, lgxgrid1.Nlist, "grid(1,1)"
End Sub

Private Sub tgetweb_Click()
  Dim Data
  'Data = "<Text><d>我是中国人</d><d>我是中国人</d></Text>"
  'Set Data = lgxgrid1.GetXml(1, lgxgrid1.rows)
  'retrunx = lgxgrid1.ToGetWeb("http://192.168.85.1/ServiceData.asmx/Gdata", "Text", "Xml", Data)
  'MsgBox (retrunx)
  'x = retrunx.documentElement.childNodes.length
  'MsgBox (retrunx.documentElement.childNodes(x - 1).Text)
  'lgxgrid3.xmltoGrid "Xml", "", retrunx
  'MsgBox (retrunx)
  CzSumx
End Sub

Private Sub To5_Click()
  Dim t As Date
  Me.MousePointer = 11
  t = Now()
  lgxgrid1.SetdRowsx 5
  MsgBox ("加载数据用时 " & DateDiff("s", t, Now()) & " 秒 行数为" & lgxgrid1.rows)
  Me.MousePointer = 0
End Sub

Private Sub To50000_Click()
Dim t As Date
Me.MousePointer = 11
t = Now()
lgxgrid1.SetdRowsx 50000 '创建100000行
'添加10列1000000行约需26秒
'每个单元格因为含有格式信息，至少占用内存32字节
'按此计算，10列1000000约占用内存260MB
MsgBox ("创建单元格用时 " & DateDiff("s", t, Now()) & " 秒 行数为" & lgxgrid1.rows)
t = Now()
For i = 1 To 50000
  For j = 1 To 10
   lgxgrid1.SetDataall i, j, i
  Next
Next
lgxgrid1.Refurbish '刷新数据显示区

MsgBox ("加载数据用时 " & DateDiff("s", t, Now()) & " 秒 行数为" & lgxgrid1.rows)
Me.MousePointer = 0
End Sub

Private Sub Toe_Click()
lgxgrid1.DataToExcel
End Sub

Private Sub ToSelect_Click()
Dim t As Date
Me.MousePointer = 11
t = Now()
lgxgrid1.RecordsetToGird "select * from 产品表 ", Mysjk
MsgBox ("加载数据用时 " & DateDiff("s", t, Now()) & " 秒 行数为" & lgxgrid1.rows)
Me.MousePointer = 0
End Sub

Private Sub xmltoGrid_Click()
  Dim Data As String
  Data = "<root>"
  For i = 1 To 100
   Data = Data & "<re>"
   For j = 1 To 10
     Data = Data & "<Fi>" & i * j & "</Fi>"
   Next
   Data = Data & "</re>"
  Next
  Data = Data & "</root>"
  lgxgrid1.xmltoGrid "XmlFile", "", "c:\qq.xml"
End Sub

 Sub CzSumx() '数据统计
 'On Error Resume Next
 Err.Clear
      Myxml = "<Root>"
      Myxml = Myxml & "<Record><![CDATA[]]><![CDATA[]]><![CDATA[ID]]><![CDATA[>]]><![CDATA[0]]><![CDATA[]]></Record>"
      Myxml = Myxml & "</Root>"
      '获取http地址路径
      webFileUrl = "http://192.168.85.1/webform/DataService.asmx/FindDataxxx?FName=CzSum"
     'webFileUrl = "http://192.168.85.1/webform/pp.htm"
      
      '生成一条服务请求字符串
      Set reXml = lgxgrid1.ToGetWeb(webFileUrl, "XML", "text", Myxml)
      lgxgrid1.xmltoGrid "XML", "1", reXml
End Sub

Sub D1KeyP(KeyAscii) '在子表上按下箭头或回车键时选择内容
  If KeyAscii >= 38 And KeyAscii <= 41 Then
      lgxgrid1.SetArea lgxgrid1.Nrow, 1, lgxgrid1.Nrow, lgxgrid1.lists
  End If
End Sub