main.frm

vb从网上取数据

                End If
            End If
    End Select
    On Error Resume Next
    DrawingTools.XcurrMov = x  'get moving x&y for drawing tools
    DrawingTools.YcurrMov = y
    
End Sub
Private Sub ResetMousePointerAfterSplitMove()
    ChartBoxV.MousePointer = vbDefault
    iMoveSplit = 0
    iCrossHair = 1
End Sub
Private Sub CrossHairStop()
    Dim i As Long
    'hide the crosshairs and info label
    For i = 0 To 2
        ChLine1(0).Visible = False
        ChLine2(0).Visible = False
    Next
    lblMousePrice.Visible = False
    iMouseDataInfo = 0
    Call ShowCursor(True)
End Sub
Private Sub ChartBoxv_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Button = 1 Then
        If iMoveSplit = 1 Then 'save positions & redraw chart if panels resized
            WriteIni sINIsetFile, "Settings", "WindowSplit1", CStr(rSplit1)
            WriteIni sINIsetFile, "Settings", "WindowSplit2", CStr(rSplit2)
            Divider(0).Visible = False
            Divider(0).X2 = ChartBox.ScaleLeft - 3
            Divider(1).Visible = False
            Divider(1).X2 = ChartBox.ScaleLeft - 3
            Call ChartBoxDraw
        End If
        Call CrossHairStop  'hide crosshairs
        iMoveSplit = 0
    ElseIf Button = 2 Then
        'If iMouseClickNum > 0 Then iMouseClickNum = iMouseClickNum - 1
    End If
    
End Sub


Private Sub cmdBarSpacing_Click(Index As Integer)
    
    If fClickingBarSpacing = 1 Or IsDrawing = 1 Then Exit Sub 'finish current op
    fClickingBarSpacing = 1
    Select Case Index
        Case 0      'increase bar spacing
            If iBarSpacing < 30 Then
                iBarSpacing = iBarSpacing + 1
            End If
        Case 1      'decrease barspacing
            If iBarSpacing > 1 Then
                iBarSpacing = iBarSpacing - 1
            End If
    End Select
    Call ChartBoxDraw
    
End Sub
Private Sub GetDataInfo()
    
    Screen.MousePointer = vbHourglass
    
    'display the last price data on the form caption
    frmMain.Caption = sCaption & aData(iUBaData).sDate & "  " & aData(iUBaData).sTime _
                & "   O: " & aData(iUBaData).dOpen & "   H: " & aData(iUBaData).dHigh _
                & "   L:" & aData(iUBaData).dLow & "   C: " & aData(iUBaData).dClose _
                & "   V: " & aData(iUBaData).iVol

    
    sCapCurrent$ = Me.Caption
    Select Case iBarDataPeriodMins
        Case -1
            stbBottom.Panels(5).Text = "间隔: 一天"
        Case -2
            stbBottom.Panels(5).Text = "间隔: 一周"
        Case Is > 0
            stbBottom.Panels(5).Text = "间隔: " & iBarDataPeriodMins & " 秒"
    End Select

    stbBottom.Panels(4).Text = "标记: " & sSymbol$
    stbBottom.Panels(1).Text = "文件: " & sFileName$

    Screen.MousePointer = vbDefault
End Sub
Public Sub ChartBoxDraw()

    Dim iStyle As Integer, iDmode As Integer, iTimeTrigger As Integer
    Dim iDateTrigger As Integer, iDateSpacing As Integer, iDayOfWeek As Integer, iCurrTime As Long
    Dim sStartTime As String, sTimeDif As String, iTimeH As Integer, iTimeM As Integer
    Dim x As Single, Y1 As Single, Y2 As Single, iCount As Integer, iCnt930 As Integer, iX2 As Integer
    Dim X1 As Long, X2 As Long, sTime As String, iNextX As Integer, sDate As String, sTemp As String
    Dim iLastDx As Long, lPriceLabelWidth As Long, sDateLast As String, iOldDayNum As Integer
    Dim iCnt As Integer, iCnt2 As Integer, rStartPos As Single, rSpacing As Single, iDateCnt As Integer
    Dim iDrWidth As Integer, sDateShort As String, dHeight2RangeRatio As Double, rLegionStartPrice As Single
    Dim iPriceLegionPosX As Long, j As Integer, iWeekTrigger As Integer
    
    Call GetDataInfo
    If fGotData = False Then Exit Sub  'no data... no plot
    If IsDrawing = True Then Exit Sub  'wait till done plotting before plotting again
    IsDrawing = True
    Screen.MousePointer = vbHourglass
On Error Resume Next

    ChartBox.Cls
    iStyle = ChartBox.DrawStyle
    iDmode = ChartBox.DrawMode
    iDrWidth = ChartBox.DrawWidth
    ChartBox.DrawMode = vbCopyPen
    
    
'Debug.Print "rsOff/barSp: "; rRightSideOffset / iBarSpacing
'Debug.Print "iNumBarsPloted: "; iNumBarsPloted
'Debug.Print "calc#:"; (Int(rRightSideOffset / iBarSpacing) + 1)
    
    iStartIndex = (iUBaData - iScrolledAmount)
    If (iStartIndex - iCalcdAvailBars2Plot) > 0 Then
        'we have more data than we are plotting
        iLboundDataStart = (iStartIndex - iCalcdAvailBars2Plot)
        tbLeft.Buttons("ScrollData").Enabled = True
    Else
        'can't plot less than the data we have
        iLboundDataStart = LBound(aData())
        tbLeft.Buttons("ScrollData").Enabled = False 'nothing to scroll
    End If

    
    'check max price against total bars to plot ... find max and min values
    dMaxPrice = 0
    dMinPrice = 999999
    dMaxVol = 1
    For j = iLboundDataStart To iStartIndex
        If aData(j).dHigh > dMaxPrice Then dMaxPrice = aData(j).dHigh
        If aData(j).dLow < dMinPrice And _
                aData(j).dLow > 0 Then dMinPrice = aData(j).dLow   'if 0 in the data ignore
        If aData(j).iVol > dMaxVol Then dMaxVol = aData(j).iVol
    Next j

'Debug.Print dMaxPrice; "  "; dMinPrice
    
    dRangePrice = dMaxPrice - dMinPrice  'price data range
    iNumBarsPloted = 0

    dHeightPrice = rSplit1 - 8 'total plot height with 4 pixels/side margin
    dHeight2RangeRatio = dHeightPrice / dRangePrice  'price per pixel
    dHeightVol = rSplit2 - rSplit1 - 8 'total plot height for vol panel
    lPriceLabelWidth = ChartBox.TextWidth(CStr(Format(dMaxPrice, "##.00"))) 'price legion width
    iPriceLegionPosX = ChartBox.ScaleWidth - lPriceLabelWidth - 5  'start of price legion
    iMaxDrawRightX = iPriceLegionPosX - 3  'max plot in x

    
'****************************************
'**************data pane Hgrid And price labels
'****************************************
    'initalize for grid
    ChartBox.DrawStyle = vbDot
    X1 = ChartBox.ScaleLeft
    X2 = ChartBox.ScaleWidth
    
    'price legion spacing is determined by the max price range.
    Select Case dRangePrice
        Case 0 To 1
            rSpacing = (0.05)
        Case 1 To 2
            rSpacing = (0.1)
        Case 2 To 4
            rSpacing = (0.25)
        Case 4 To 10
            rSpacing = (0.5)
        Case 10 To 20
            rSpacing = (1)
        Case 20 To 30
            rSpacing = (2)
        Case Else
            rSpacing = (3)
    End Select
    'start at the price integer... and work both directions
    'makes a better looking legion using rounded price numbers
    'like 50.70 instead of -> 50.67
    rLegionStartPrice = Round(dMaxPrice - rSpacing, 1)
    rStartPos = 4 + (dMaxPrice - rLegionStartPrice) * dHeight2RangeRatio

    Y1 = Round(rStartPos)
'Debug.Print Round(dMaxPrice - rSpacing, 1)
'Debug.Print rSpacing
'Debug.Print ((dMaxPrice - Int(dMaxPrice)) * dHeight2RangeRatio)
'Debug.Print "y1:"; Y1
'Debug.Print "dMaxPrice:"; dMaxPrice
'Debug.Print "dMin:"; dMinPrice
'Debug.Print "Int(dMaxP:"; Int(dMaxPrice)
'Debug.Print "dH2RRat:"; dHeight2RangeRatio

    Do While Y1 < (rSplit1 - iTextHeight)  'make sure don't print on the divider
        DoEvents
        ChartBox.Line (X1, Y1)-(iPriceLegionPosX, Y1), iGridColor
        ChartBox.CurrentX = iPriceLegionPosX
        ChartBox.CurrentY = ChartBox.CurrentY - iTextHeight / 2 + 1
        ChartBox.Print Format(rLegionStartPrice - (iCnt * rSpacing), "##.00")
        If iCnt = 0 Then 'it is the first horz grid line at the interger val
            If rStartPos - (rSpacing * dHeight2RangeRatio) > 4 Then  'we aren't at the top
                Y2 = rStartPos
                'now we work from the integer val up to the top of the price panel
                Do While Y2 > iTextHeight * 3 '/ 2 + 1
                    DoEvents
                    iCnt2 = iCnt2 + 1 'grid up count
                    Y2 = 4 + ((dMaxPrice - rLegionStartPrice - iCnt2 * rSpacing) * dHeight2RangeRatio)
                    ChartBox.Line (X1, Y2)-(iPriceLegionPosX, Y2), iGridColor
                    ChartBox.CurrentX = iPriceLegionPosX
                    ChartBox.CurrentY = ChartBox.CurrentY - iTextHeight / 2 + 1
                    ChartBox.Print Format(rLegionStartPrice + (iCnt2 * rSpacing), "##.00")
                Loop
            End If
        End If
        iCnt = iCnt + 1 'grid down count
        Y1 = 4 + ((dMaxPrice - rLegionStartPrice + iCnt * rSpacing) * dHeight2RangeRatio)
    Loop
'*****************vol pane Hgrid
    ChartBox.DrawStyle = vbDot
    ChartBox.DrawWidth = 1
    iPriceLegionPosX = ChartBox.ScaleWidth - ChartBox.TextWidth(CStr(dMaxVol)) - 10
    For Y1 = rSplit2 - dMaxVol * (dHeightVol / dMaxVol) To rSplit2 Step 20
        ChartBox.Line (X1, Y1)-(iPriceLegionPosX, Y1), iGridColor
        ChartBox.CurrentX = iPriceLegionPosX
        ChartBox.CurrentY = ChartBox.CurrentY - iTextHeight / 2 + 1
        If ChartBox.CurrentY < rSplit2 - iTextHeight Then _
            ChartBox.Print Round((rSplit2 - Y1) / (dHeightVol / dMaxVol))
    Next Y1

'***************************************************************************
'*****************************************************************************
'*************************start draw data loop
'****************************************************************************
'****************************************************************************

    x = rRightSideOffset
    iNextX = x
    iLastDx = x
    iCount = iStartIndex
    iMostRecentBarIndex = iCount
    'start at right side, go Left. Stop if no more data or we reached left side
    Do While x > 0 And iCount > LBound(aData, 1)
     
'Debug.Print "x: "; X; "  #bars: "; iNumBarsPloted

'*************time legion & vert grid
        
        sTime$ = aData(iCount).sTime
'Debug.Print stime$
        sDate$ = aData(iCount).sDate
        iDayOfWeek = Weekday(sDate$)
'Debug.Print sDate$; "  "; Weekday(sDate$)
'Debug.Print sDatelast$
        
        'need to calculate the first day of week different for end of day data
        If iBarDataPeriodMins < 0 Then
            Dim iPrevDay As Integer
            iPrevDay = Weekday(aData(iCount - 1).sDate)
            Select Case iDayOfWeek
                Case 2, 3 ' mon or tue
                    'if prev day is a thur or fri then week flag=true
                    If iPrevDay = 6 Or iPrevDay = 5 Then iWeekTrigger = 1
                Case Else
                    iWeekTrigger = 0
            End Select
'Debug.Print "iPv:"; iPrevDay; " day:"; iDayOfWeek; " tr:"; iWeekTrigger
        ElseIf iBarDataPeriodMins > 0 Then
            Select Case iOldDayNum
                Case 2, 3 ' mon or tue
                    'if prev day is a thur or fri then week flag=true
                    If iDayOfWeek = 6 Or iDayOfWeek = 5 Then iWeekTrigger = 1
                Case Else
                    iWeekTrigger = 0
            End Select
            iOldDayNum = iDayOfWeek
            
        End If
        sTime$ = Trim(Mid(sTime$, InStr(sTime$, " ") + 1))
'Debug.Print stime$
        Select Case Mid(sTime$, InStr(sTime$, ":") + 1)
            Case "00", "15", "30", "45"  'keep the time legion on "pretty" values
                iTimeTrigger = 1
        End Select
        
        
        ChartBox.DrawStyle = vbSolid
        ChartBox.DrawWidth = 1
'***************Date labels
        Dim iX As Integer  'copy of x pos. for manipulation
        Select Case sTime$
            Case "0930", "09:30", "1600", "16:00"
                'start/end of traditional trading day
                iCnt930 = iCnt930 + 1
                If iCnt930 = 1 Then iX = x  'save current x
        End Select
        If sDate$ <> sDateLast$ Then iDateTrigger = 1 'make sure of new date
'Debug.Print iMostRecentBarIndex
'Debug.Print "iLastDx:"; iLastDx; ChartBox.ScaleWidth
'Debug.Print stime$
'Debug.Print iBarDataPeriodMins
        If iDateTrigger = 1 Then
'Debug.Print "iDateTrigger:"; iDateTrigger
'Debug.Print "x:"; x
            If iLastDx <> rRightSideOffset Or iBarDataPeriodMins < 0 Then
                Dim CurrY As Long
                CurrY = ChartBox.ScaleHeight - (iTextHeight)
                ChartBox.CurrentY = CurrY
                ChartBox.CurrentX = x + 1
                If iBarDataPeriodMins > 0 Then  'minute data
                    sDateShort$ = Left$(sDateLast$, 5)
                    If iLastDx - x > ChartBox.TextWidth(sDateLast$) + 10 Then
                        'we have room for long date string
                        ChartBox.Print sDateLast$
                        ChartBox.CurrentX = x
                        ChartBox.Line (x, ChartBox.ScaleHeight)-(x, iBottomPlotMargin), iDateMarkerColor
                        iLastDx = x
                    ElseIf iLastDx - x > ChartBox.TextWidth(sDateShort$) + 10 Then
                        'use short date string
                        ChartBox.Print sDateShort$
                        ChartBox.CurrentX = x
                        ChartBox.Line (x, ChartBox.ScaleHeight)-(x, iBottomPlotMargin), iDateMarkerColor
                        iLastDx = x
                    Else
                        'iLastDx stays the same until we have room for the string
                    End If
                    If x <> rRightSideOffset Then iDateCnt = iDateCnt + 1
'Debug.Print "x:"; x; " rRSO:"; rRightSideOffset
                ElseIf iBarDataPeriodMins < 0 Then  'daily data
'Debug.Print iLastDx; rRightSideOffset
'Debug.Print iLastDx - x; ChartBox.TextWidth(sDate$)
'Debug.Print iWeekTrigger; sDate
                    sDateShort$ = Left$(sDate$, 5)
                    If iLastDx - x > ChartBox.TextWidth(sDate$) + 10 Or _
                           iCount = iMostRecentBarIndex Then
                        'we have room for long date string
                        ChartBox.Print sDate$
                        ChartBox.CurrentX = x
                        ChartBox.Line (x, ChartBox.ScaleHeight)-(x, iBottomPlotMargin), iDateMarkerColor
                        ChartBox.DrawStyle = vbDot
                        ChartBox.Line (x, ChartBox.ScaleTop)-(x, iBottomPlotMargin), iGridColor
                        iLastDx = x
                    ElseIf iLastDx - x > ChartBox.TextWidth(sDateShort$) + 10 Then
                        'use short date string
                        ChartBox.Print sDateShort$
                        ChartBox.CurrentX = x
                        ChartBox.Line (x, ChartBox.ScaleHeight)-(x, iBottomPlotMargin), iDateMarkerColor
                        ChartBox.DrawStyle = vbDot
                        ChartBox.Line (x, ChartBox.ScaleTop)-(x, iBottomPlotMargin), iGridColor
                        iLastDx = x
                    Else
                        'iLastDx stays the same until we have room for the string
                    End If
                End If
            Else
                
                iLastDx = ChartBox.ScaleWidth
            End If
            
        End If