select.bas

股票分析

Attribute VB_Name = "OneStockInf"
Public Function getFileNameFromInputbox() As Integer
    Dim txt As String
    Dim flg1, flg2 As String
    While 1
       OneStockFileName = ""
       txt = InputBox("600000", "请输入股票代码：")
       If txt = "" Then GoTo myEnd
       OneStockFileName = DayDir + "sh" + txt + ".day"
       flg1 = Dir(OneStockFileName)
       OneStockFileName = DayDir + "sz" + txt + ".day"
       flg2 = Dir(OneStockFileName)
       If flg1 = "" And flg2 = "" Then
          MsgBox "Code Error!Input again....."
       Else
          GoTo myOut
       End If
    Wend
    
myOut:

    OneStockFileName = ""
    If flg1 <> "" Then OneStockFileName = DayDir + "sh" + txt + ".day"
    If flg2 <> "" Then OneStockFileName = DayDir + "sz" + txt + ".day"

    getFileNameFromInputbox = 1
    Exit Function
myEnd:
    getFileNameFromInputbox = 0

End Function
Public Function getPeriodic() As Integer
    Dim txt, filename, flg1, flg2 As String
    Dim i, j, s, t, ss, tt As Integer
    Dim Periodic(1000, 3), StartPrice, EndPrice, tempDate As Long
On Error GoTo myEnd
    RetVal = getFileNameFromInputbox()
    If RetVal <> 1 Then GoTo myEnd
    filename = OneStockFileName
    i = 1
    j = 0
    StartPrice = 0
    EndPrice = 0
    Open filename For Binary As #1 Len = Len(DFS)
         Get #1, , DFS: j = j + 1
         tempDate = DFS.myDate
         StartPrice = DFS.ClosePrice
         While Not EOF(1)
             Get #1, , DFS: j = j + 1
             If DFS.ClosePrice <> 0 And StartPrice <> 0 Then
                 If DFS.ClosePrice / StartPrice > 1.1 Or StartPrice / DFS.ClosePrice > 1.1 Then
                    
                     Periodic(i, 1) = tempDate
                     Periodic(i, 0) = DFS.myDate
                     tempDate = DFS.myDate
                     If DFS.ClosePrice > StartPrice Then
                        Periodic(i, 2) = 1
                     Else
                        Periodic(i, 2) = -1
                     End If
                     Periodic(i, 3) = j: i = i + 1: j = 0
                     StartPrice = DFS.ClosePrice
                 End If
             End If
         Wend
    Close #1
    txt = filename + vbCrLf + "日期           " + "升降          " + "天数           " + vbCrLf
    For i = 1 To 999
        If Periodic(i, 3) <> 0 Then
           txt = txt + CStr(Periodic(i, 1)) + " - " + CStr(Periodic(i, 0)) + "               "
           If Periodic(i, 2) = 1 Then txt = txt + "升  10%  用了  "
           If Periodic(i, 2) = -1 Then txt = txt + "降  10%  用了  "
           txt = txt + CStr(Periodic(i, 3)) + "天" + vbCrLf
        End If
    Next
    Unload OneStockInformation
    Load Form1
    Form1.Show
    Form1.Text1.Text = txt
    s = 0
    t = 0
    For i = 1 To 1000
        If Periodic(i, 3) = 0 Then Exit For
        If Periodic(i, 2) = -1 Then s = s + 1: ss = ss + Periodic(i, 3)
        If Periodic(i, 2) = 1 Then t = t + 1: tt = tt + Periodic(i, 3)
    Next
    If s <> 0 And t <> 0 Then MsgBox "Down :" + CStr(ss / s) + vbCrLf + "Rise :" + CStr(tt / t)
    
    getPeriodic = 1
    Exit Function
myEnd:
     getPeriodic = 0
     
End Function
   
Public Function getTotalChange() As Integer

    Dim txt, filename, flg1, flg2 As String
    Dim i, j, s, t, ss, tt As Integer
    Dim LowPrice, TopPrice As Long
    Dim PriceChange(1000, 3) As Double
On Error GoTo myEnd
    RetVal = getFileNameFromInputbox()
    If RetVal <> 1 Then GoTo myEnd
    filename = OneStockFileName

    i = 1
    j = 0
    LowPrice = 0
    TopPrice = 0
    Open filename For Binary As #1 Len = Len(DFS)
         Get #1, , DFS
         LowPrice = DFS.ClosePrice
         TopPrice = DFS.ClosePrice
         While Not EOF(1)
             Get #1, , DFS
             If StartDate <> 0 And EndDate <> 0 Then
                If DFS.myDate >= StartDate And DFS.myDate <= EndDate Then
                   If DFS.ClosePrice < LowPrice Then LowPrice = DFS.ClosePrice
                   If DFS.ClosePrice > TopPrice Then TopPrice = DFS.ClosePrice
                End If
             Else
                If DFS.ClosePrice < LowPrice Then LowPrice = DFS.ClosePrice
                If DFS.ClosePrice > TopPrice Then TopPrice = DFS.ClosePrice
             End If
         Wend
    Close #1
    Erase PriceChange
    Open filename For Binary As #1 Len = Len(DFS)
         While Not EOF(1)
             Get #1, , DFS
             If StartDate <> 0 And EndDate <> 0 Then
                If DFS.myDate >= StartDate And DFS.myDate <= EndDate Then
                   i = (DFS.ClosePrice - LowPrice) \ 10 + 1
                   PriceChange(i, 1) = DFS.ClosePrice
                   PriceChange(i, 2) = PriceChange(i, 2) + DFS.TotalChange
                   PriceChange(i, 3) = DFS.myDate
                End If
             Else
                i = (DFS.ClosePrice - LowPrice) \ 10 + 1
                PriceChange(i, 1) = DFS.ClosePrice
                PriceChange(i, 2) = PriceChange(i, 2) + DFS.TotalChange
                PriceChange(i, 3) = DFS.myDate
             End If
         Wend
    Close #1
    txt = filename + vbCrLf + "价位" + "总手" + vbCrLf
    For i = 1 To 1000
        If PriceChange(i, 1) <> 0 Then
           If PriceChange(i, 1) \ 1000 = 0 Then txt = txt + " "
           txt = txt + CStr(PriceChange(i, 1)) + "     "
        
           If PriceChange(i, 2) < 10000000000# Then
              txt = txt + " "
           End If
           txt = txt + CStr(PriceChange(i, 2)) + "     "
          
           txt = txt + CStr(PriceChange(i, 3)) + vbCrLf
        End If
    Next
    Unload OneStockInformation
    Load Form1
    Form1.Show
    Form1.Text1.Text = txt

    
    
    
    
    getTotalChange = 1
    Exit Function
myEnd:
    getTotalChange = 0

End Function

Public Function getJingDate() As Integer





End Function
Public Function getDownOfPriceDates() As Integer

    Dim txt, filename, flg1, flg2 As String
    Dim i, j, s, t, ss, tt, DateLong As Integer
    Dim LowPrice, TopPrice, CorrectPrice As Long
    Dim PriceChange(1000, 3) As Double
On Error GoTo myEnd
    RetVal = getFileNameFromInputbox()
    If RetVal <> 1 Then GoTo myEnd
    filename = OneStockFileName
     While 1
         CorrectPrice = 0
         flg = 0
         s = InputBox("10.00元", "价位：")
         flg = 1
         For i = 1 To Len(s)
             If Mid(s, i, 1) < "0" Or Mid(s, i, 1) > "9" Then
                If Mid(s, i, 1) <> "." Then
                   flg = 0
                End If
             End If
         Next
         If s <> "" And flg = 1 Then CorrectPrice = CLng(s * 100)
         If flg = 1 Or s = "" Then GoTo myOut
     Wend
myOut:
    DateLong = 0
    Open filename For Binary As #1 Len = Len(DFS)
         Get #1, , DFS
         While Not EOF(1)
             Get #1, , DFS
             If DFS.ClosePrice <= CorrectPrice Then DateLong = DateLong + 1
         Wend
    Close #1
    MsgBox "在日期：" + CStr(StartDate) + "-" + CStr(EndDate) + "  之间，共有：    " + _
          CStr(DateLong) + "   天在" + CStr(CorrectPrice / 100) + "元之下 "
    
    
    
    
    getDownOfPriceDates = 1
    Exit Function
myEnd:
    getDownOfPriceDates = 0




End Function