frm3.frm

利用通讯录记载股票交易记录的例子自动保存查询

   Begin VB.Label Label11 
      BackColor       =   &H00FFC0C0&
      Caption         =   "E-mail:"
      Height          =   255
      Left            =   0
      TabIndex        =   37
      Top             =   3720
      Width           =   735
   End
   Begin VB.Label Label10 
      BackColor       =   &H00FFC0C0&
      Caption         =   "日期备注"
      Height          =   375
      Left            =   3960
      TabIndex        =   36
      Top             =   2640
      Width           =   495
   End
   Begin VB.Label Label9 
      BackColor       =   &H00FFC0C0&
      Caption         =   "资金(万元)"
      Height          =   375
      Left            =   3840
      TabIndex        =   35
      Top             =   2160
      Width           =   615
   End
   Begin VB.Label Label8 
      BackColor       =   &H00FFC0C0&
      Caption         =   "合作者uc号"
      Height          =   375
      Left            =   3840
      TabIndex        =   34
      Top             =   1680
      Width           =   615
   End
   Begin VB.Label Label7 
      BackColor       =   &H00FFC0C0&
      Caption         =   "当前盈利"
      Height          =   255
      Left            =   1920
      TabIndex        =   33
      Top             =   2760
      Width           =   855
   End
   Begin VB.Label Label6 
      BackColor       =   &H00FFC0C0&
      Caption         =   "卖出量"
      Height          =   255
      Left            =   2040
      TabIndex        =   32
      Top             =   2280
      Width           =   615
   End
   Begin VB.Label Label5 
      AutoSize        =   -1  'True
      BackColor       =   &H00FFC0C0&
      Caption         =   "买入量:"
      Height          =   180
      Left            =   2040
      TabIndex        =   31
      Top             =   1800
      Width           =   630
   End
   Begin VB.Label Label4 
      AutoSize        =   -1  'True
      BackColor       =   &H00FFC0C0&
      Caption         =   "最新价"
      Height          =   180
      Left            =   240
      TabIndex        =   30
      Top             =   3240
      Width           =   540
   End
   Begin VB.Label Label3 
      AutoSize        =   -1  'True
      BackColor       =   &H00FFC0C0&
      Caption         =   "成本价:"
      Height          =   180
      Left            =   240
      TabIndex        =   29
      Top             =   2760
      Width           =   630
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      BackColor       =   &H00FFC0C0&
      Caption         =   "当前持有:"
      Height          =   180
      Left            =   120
      TabIndex        =   28
      Top             =   2280
      Width           =   810
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      BackColor       =   &H00FFC0C0&
      Caption         =   "股票代码:"
      Height          =   180
      Left            =   120
      TabIndex        =   27
      Top             =   1800
      Width           =   810
   End
End
Attribute VB_Name = "Form23"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Dim FileName As String
    Private Sub Command1_Click()
    '将文本框中的信息添加到列表框中
    Dim i As Integer
      With ListView1.ListItems.Add()
        .Text = Text1(0)
        For i = 1 To 9
        .SubItems(i) = Text1(i)
      Next i
      End With
      
     ' 多于一页.出现滚动条..如何使滚动条移到最下面.显示出最后一行
      ListView1.ListItems.Item(ListView1.ListItems.Count).Selected = True
  ListView1.StartLabelEdit
  'ListView1这行并不能滚动到当前页上..也就是看不到最后一条
  ListView1.ListItems(ListView1.ListItems.Count).EnsureVisible
  
  '保存数据
  ' Dim i As Integer
    Dim tpList As ListItem
    '保存数据
   'Open App.Path & "\Langdu.ini" For Append As #1
 ' Open App.path & "\Hezuo.ini" For Output As #1
  Open FileName For Output As #1

      For Each tpList In ListView1.ListItems()
        Print #1, tpList.Text
        For i = 1 To 9
          Print #1, tpList.SubItems(i)
        Next i
      Next tpList
    Close #1
    End Sub

Private Sub Command10_Click() '将无法看到text1中的变化,而只在循环结束时看到最后结果
   Dim l As Long
    Do
     l = l + 1
     Debug.Print l
     DoEvents
    Loop
    
End Sub


Private Sub Command11_Click()
ListView1.ListItems.Item(1).Selected = True

End Sub

Private Sub Command12_Click()
ListView1.ListItems.Clear
Command1 = True
Command1 = True
Command11 = True
End Sub

Private Sub Command13_Click()
ListView1.ColumnHeaders.Clear
'ListView1.ListItems和ListView1.ColumnHeaders也都支持Remove
End Sub



Private Sub Command14_Click()
Dim Item
  Set Item = ListView1.ListItems.Add
  Item.Text = "1"
  Item.SubItems(1) = "我"
  Item.SubItems(2) = "要"
  Item.SubItems(3) = "分"
  Set Item = Nothing
End Sub

Private Sub Command15_Click()
ListView1.ListItems.Item(2).Selected = True

End Sub

Private Sub Command16_Click()
MsgBox ListView1.ListItems.Count & "行"
MsgBox ListView1.ColumnHeaders.Count & "列"
End Sub

Private Sub Command17_Click()
  Dim i As Integer
    Dim tpList As ListItem
    '保存数据
   'Open App.Path & "\Langdu.ini" For Append As #1
  ''Open App.path & "\Hezuo.ini" For Output As #1
    Open App.Path & "\Hezuo.ini" For Append As #1
      For Each tpList In ListView1.ListItems
        Print #1, tpList.Text
        For i = 1 To 9
          Print #1, tpList.SubItems(i)
        Next i
      Next tpList
    Close #1
End Sub

    Private Sub Command2_Click()
    '删除列表框中信息
    If ListView1.ListItems.Count > 0 Then
      'If MsgBox("真的要删除吗？", vbQuestion + vbYesNo + vbDefaultButton2) = vbYes Then
      ListView1.ListItems.Remove ListView1.SelectedItem.Index
      End If
   ' End If
    '保存数据
  Dim i As Integer
    Dim tpList As ListItem
    '保存数据
   'Open App.Path & "\Langdu.ini" For Append As #1
 ' Open App.path & "\Hezuo.ini" For Output As #1
  Open FileName For Output As #1

      For Each tpList In ListView1.ListItems()
        Print #1, tpList.Text
        For i = 1 To 9
          Print #1, tpList.SubItems(i)
        Next i
      Next tpList
    Close #1
    End Sub

Private Sub Command3_Click()
Unload Me
End Sub

Private Sub Command4_Click()
  
Text1(0) = ListView1.SelectedItem.Text '第1列
Text1(1) = ListView1.SelectedItem.ListSubItems(1)    '  第2列
Text1(2) = ListView1.SelectedItem.ListSubItems(2)    '  第3列
Text1(3) = ListView1.SelectedItem.ListSubItems(3)    '  第4列
Text1(4) = ListView1.SelectedItem.ListSubItems(4)    '  第5列
Text1(5) = ListView1.SelectedItem.ListSubItems(5)    '  第6列
Text1(6) = ListView1.SelectedItem.ListSubItems(6)    '  第7列
Text1(7) = ListView1.SelectedItem.ListSubItems(7)    '  第8列
Text1(8) = ListView1.SelectedItem.ListSubItems(8)    '  第9列
Text1(9) = ListView1.SelectedItem.ListSubItems(9)    '  第10列
'Text1(10) = ListView1.SelectedItem.ListSubItems(10)    '  第11列
End Sub

Private Sub Command5_Click()
Set ListView1.SelectedItem = ListView1.ListItems(ListView1.SelectedItem.Index - 1)

End Sub

Private Sub Command6_Click()

If ListView1.SelectedItem.Index = ListView1.ListItems.Count Then
Command11 = True
End If
Set ListView1.SelectedItem = ListView1.ListItems(ListView1.SelectedItem.Index + 1)
End Sub

Private Sub Command7_Click()
ListView1.ColumnHeaders.Remove ListView1.ColumnHeaders.Count
End Sub

Private Sub Command8_Click()
ListView1.ColumnHeaders.Add

End Sub

Private Sub Command9_Click()
Dim itmX As ListItem
Set itmX = ListView1.ListItems.Add(, , "张三")
itmX.SubItems(1) = 28
itmX.SubItems(2) = "男"
Set itmX = ListView1.ListItems.Add(, , "李四")
itmX.SubItems(1) = 26
itmX.SubItems(2) = "女"
 ListView1.ListItems(ListView1.ListItems.Count).EnsureVisible
End Sub

    Private Sub Form_Load()
    
 Dim tpStr As String, i As Integer, j As Integer
    Me.Caption = "通讯录"
    For j = 0 To 9
     Text1(j).Text = ""
    Next j
    
    FileName = App.Path & "\Hezuo.ini"
If Dir(FileName) <> "" Then
      '加载数据
      Open FileName For Input As #1
        Do While Not EOF(1)
          With ListView1.ListItems.Add()
            For i = 0 To 9
              Line Input #1, tpStr
              If i = 0 Then
                .Text = tpStr
              Else
                .SubItems(i) = tpStr
              End If
            Next i
          End With
        Loop
      Close #1
    End If
    End Sub

Private Sub Label7_Click()
Command17 = True
End Sub

Private Sub ListView1_BeforeLabelEdit(Cancel As Integer)
ListView1.ListItems(ListView1.ListItems.Count).EnsureVisible
End Sub
Private Sub ListView1_DblClick()
      If Me.ListView1.SelectedItem Is Nothing Then
      Exit Sub
      End If
      Dim Item As ListItem
      Set Item = Me.ListView1.SelectedItem
  Val (Label6.Caption)
  Command4 = True
  ListView1.SelectedItem.ListSubItems(6) = Val(Form23.Text1(1)) * Val(Form23.Text1(3)) * 0.995 - Val(Form23.Text1(1)) * Val(Form23.Text1(2)) * 1.005
  'Form22.CmdEvaluate = True
 ' ListView1.SelectedItem.ListSubItems(6) = Form22.ResultLabel
      'MsgBox Item.Text       '显示被双击的条目的text
MsgBox "显示被双击的条目的"
End Sub
'请问如和得到鼠标所在处的listview的行数和列数啊
Private Sub ListView1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  ListView1.ToolTipText = "行数：" & ListView1.ListItems.Count & "列数：" & ListView1.ColumnHeaders.Count
  

  End Sub

 Private Sub Form_Unload(Cancel As Integer)
Unload Me
    End Sub