main.frm

vb从网上取数据

'Debug.Print "iDateCnt"; iDateCnt
'Debug.Print "x:"; x; " rRSO:"; rRightSideOffset
'Debug.Print "x:"; x; " iC:"; iCount; " LB:"; LBound(aData, 1)
        If iDateCnt = 0 Then   'print date if all data is for 1 day
            If x - iBarSpacing <= 0 Or iCount = LBound(aData, 1) + 1 Then
                ChartBox.CurrentY = ChartBox.ScaleHeight - (iTextHeight)
                ChartBox.CurrentX = ChartBox.ScaleLeft + 2
                ChartBox.Print sDateLast$
            End If
        End If
                    
        '***** Time labels
        If iTimeTrigger = 1 Then
            If iNextX >= x Then 'we have room for the time string
                ChartBox.CurrentX = x - (ChartBox.TextWidth(sTime$) / 2)
                ChartBox.CurrentY = iBottomPlotMargin
                ChartBox.Print sTime$
        '*****' vert grid
                ChartBox.DrawStyle = vbDot
                Y1 = ChartBox.ScaleTop
                Y2 = iBottomPlotMargin  ' ChartBox.ScaleHeight - 35
                ChartBox.Line (x, Y1)-(x, Y2), iGridColor
                'short "pointer line" in red to time string
                Y1 = iBottomPlotMargin - 10  'ChartBox.ScaleHeight - 25
                ChartBox.DrawStyle = vbSolid
                ChartBox.Line (x, Y1)-(x, Y2), vbRed
                iNextX = x - ChartBox.TextWidth(sTime$) - 5
            End If
            'sDateLast$ = sDate$
        End If
        ChartBox.DrawStyle = vbDot
        'draw the day marker here so it will be on top of grid
        If iDateTrigger = 1 And iBarDataPeriodMins > 0 Then
            sDateLast$ = sDate$
            ChartBox.Line (x, ChartBox.ScaleTop)-(x, iBottomPlotMargin), iDateMarkerColor '1911939  'iGridColor
        End If
'************************************
''***********************************
'*****price bar plot
'************************************
'************************************
        ChartBox.DrawStyle = vbSolid
        Select Case iTicType
            Case ttHLOC  'standard HLOC bar plot
                'price body
                Y1 = 4 + (dMaxPrice - aData(iCount).dHigh) * dHeight2RangeRatio
                Y2 = 4 + (dMaxPrice - aData(iCount).dLow) * dHeight2RangeRatio
                ChartBox.Line (x, Y1)-(x, Y2), iTicBodyColor
                'open tick
                Y1 = 4 + (dMaxPrice - aData(iCount).dOpen) * dHeight2RangeRatio
                ChartBox.Line (x - 2, Y1)-(x + 1, Y1), iTicOpenColor
                'close tick
                Y1 = 4 + (dMaxPrice - aData(iCount).dClose) * dHeight2RangeRatio
                ChartBox.Line (x, Y1)-(x + 3, Y1), iTicCloseColor
            Case ttCandle  'candle plot
                Dim iCandleColor As Long
                'if close >open then plot color is up color
                If aData(iCount).dClose - aData(iCount).dOpen >= 0 Then
                    iCandleColor = iTicCandleUpColor
                Else
                    iCandleColor = iTicCandleDnColor
                End If
                'price body
                Y1 = 4 + (dMaxPrice - aData(iCount).dOpen) * dHeight2RangeRatio  'open
                Y2 = 4 + (dMaxPrice - aData(iCount).dClose) * dHeight2RangeRatio  'close
                If iBarSpacing > 6 Then  'draw a "fatter" candle body
                    ChartBox.Line (x - 2, Y1)-(x + 3, Y2), iCandleColor, BF
                Else
                    ChartBox.Line (x - 1, Y1)-(x + 1, Y2), iCandleColor, BF
                End If
                'wick  from high to lo
                Y1 = 4 + (dMaxPrice - aData(iCount).dHigh) * dHeight2RangeRatio   'hi
                Y2 = 4 + (dMaxPrice - aData(iCount).dLow) * dHeight2RangeRatio   'lo
                ChartBox.Line (x, Y1)-(x, Y2), iCandleColor
            Case ttLine 'only plot from close to close
                Y1 = 4 + (dMaxPrice - aData(iCount).dClose) * dHeight2RangeRatio
                Y2 = 4 + (dMaxPrice - aData(iCount - 1).dClose) * dHeight2RangeRatio
                ChartBox.Line (x - iBarSpacing, Y2)-(x, Y1), iTicCloseColor
        End Select
'************************vol data
        ChartBox.DrawStyle = vbSolid
        ChartBox.DrawWidth = 2
        Y1 = rSplit2 - 1
        Y2 = rSplit2 - (aData(iCount).iVol * (dHeightVol / dMaxVol))
        ChartBox.Line (x, Y1)-(x, Y2), iVolColor
        
'*******************set-up for next bar
        iNumBarsPloted = iNumBarsPloted + 1
        iTimeTrigger = 0
        iDateTrigger = 0
        iCount = iCount - 1
        x = x - iBarSpacing
    Loop
    
'****print vol data
    sTemp$ = "Volume: " & aData(iCount).iVol
    'draw a "blackout rect for better visibility of the text
    ChartBox.Line (1, rSplit1 + 3)-(1 + ChartBox.TextWidth(sTemp$), rSplit1 + 3 + ChartBox.TextHeight(sTemp$)), iBackColor, BF
    ChartBox.CurrentX = 1
    ChartBox.CurrentY = rSplit1 + 3
    ChartBox.Print "Volume: " & aData(iCount).iVol
    
    iX = 0
'Debug.Print "iNumBarsPloted: "; iNumBarsPloted

'******************************************
'********plot indicators
    Call PlotAvg
    Call PlotIndicator
    
'********draw dividers
    ChartBox.DrawStyle = vbSolid
    ChartBox.Line (0, rSplit1)-(ChartBox.ScaleWidth + 5, rSplit1), vbRed
    ChartBox.Line (0, rSplit2)-(ChartBox.ScaleWidth + 5, rSplit2), vbRed

'****************exit clean up
    ChartBox.DrawMode = iDmode
    ChartBox.DrawStyle = iStyle
    ChartBox.DrawWidth = iDrWidth
    ChartBoxV.Picture = ChartBox.Image
    IsChartDrawn = True
    IsDrawing = 0
    fClickingBarSpacing = 0
    Screen.MousePointer = vbDefault
End Sub

Private Sub mnuPuBarSpacing_Click()
    Dim sText As String, sInpResult As String
    
    sText$ = "Enter Bar Spacing....  " & vbCrLf & vbCrLf _
            & "Current Setting: " & iBarSpacing
    sInpResult$ = InputBox(sText$, sSettingChange$, iBarSpacing)
    
    If sInpResult$ <> "" And IsNumeric(sInpResult$) Then
        If Val(sInpResult$) < 1 Then Exit Sub
        iBarSpacing = CInt(sInpResult$)
        Call ChartBoxDraw
    End If
End Sub

Private Sub mnuPuBlankSpace_Click()
    Dim sText As String, sInpResult As String
    
    sText$ = "Enter Right side of chart 'Blank Space'....10 Minimum. " _
            & vbCrLf & vbCrLf & "Current Setting: " & iBlankSpace
    sInpResult$ = InputBox(sText$, sSettingChange$, iBlankSpace)
    
    If sInpResult <> "" And IsNumeric(sInpResult$) Then
        If Val(sInpResult$) < 10 Then Exit Sub
        iBlankSpace = CInt(sInpResult$)
        Call SetMargins
        Call ChartBoxDraw
    End If
End Sub

Private Sub mnuPuCancelDrawing_Click()
    fCancelDrawingTool = True
End Sub

Private Sub mnuPuCrossHairColor_Click()
    iCrossHairColor = GetColorDlg(iCrossHairColor)
End Sub

Private Sub mnuPuCrossHairMode_Click()
    Dim sText As String, sInpResult As String

    sText$ = "Enter new DrawMode for crosshairs...." _
            & "Any number from 1 to 16.  " _
            & "6,8,15 work best...   15 is default."
    sInpResult$ = InputBox(sText$, sSettingChange$, iCrossHairMode)
    
    If sInpResult$ <> "" And IsNumeric(sInpResult$) Then
        If sInpResult$ > 0 And sInpResult$ < 17 Then _
            iCrossHairMode = CInt(sInpResult$)
    End If
    
End Sub

Private Sub mnuPuIndSettings_Click()
    frmIndicators.Show 1, Me
End Sub

Private Sub mnuPuSettingsChart_Click()
    Call GetOptionsDlg
End Sub

Private Sub stbBottom_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    If InStr(stbBottom.Panels(4).Text, sUnknownSymbol$) <> 0 Then
        stbBottom.Panels(4).ToolTipText = "DblClick to edit"
    Else
        stbBottom.Panels(4).ToolTipText = sEmpty
    End If
End Sub

Private Sub stbBottom_PanelDblClick(ByVal Panel As MSComctlLib.Panel)
    Select Case Panel.Index
        Case 4
            'if the symbol in unknown then it can be entered by dblclk the symbol status panel
            If InStr(Panel.Text, sUnknownSymbol$) <> 0 Then MsgBox "left as exercise for....."
    End Select
End Sub

Private Sub SetupToolbar()
    
    tbLeft.ImageList = imgList  'set tb image list
    
    'set button images
    tbLeft.Buttons("ReDraw").Image = "ReDraw"
    tbLeft.Buttons("IncBarSpace").Image = "IncBarSpace"
    tbLeft.Buttons("DecBarSpace").Image = "DecBarSpace"
    tbLeft.Buttons("ScrollData").Image = "ScrollData"
    tbLeft.Buttons("OpenFile").Image = "OpenFile"
    tbLeft.Buttons("DownLoad").Image = "DownLoad"
    tbLeft.Buttons("Options").Image = "Options"
    tbLeft.Buttons("Indicators").Image = "Indicators"
    tbLeft.Buttons("DrawingTools").Image = "DrawingTools"
    tbLeft.Buttons("Camera").Image = "Camera"
    tbLeft.Buttons("About").Image = "About"
    
    'set tb tooltips
    tbLeft.Buttons("ReDraw").ToolTipText = "刷新"
    tbLeft.Buttons("IncBarSpace").ToolTipText = "增加Increase BarSpacing"
    tbLeft.Buttons("DecBarSpace").ToolTipText = "减少Decrease BarSpacing"
    tbLeft.Buttons("ScrollData").ToolTipText = "Scroll-LButton Left 1-RButton Right 1- +Shift 10+ Incr."
    tbLeft.Buttons("OpenFile").ToolTipText = "打开文件"
    tbLeft.Buttons("DownLoad").ToolTipText = "下载数据"
    tbLeft.Buttons("Options").ToolTipText = "选项"
    tbLeft.Buttons("Indicators").ToolTipText = "示例"
    tbLeft.Buttons("DrawingTools").ToolTipText = "绘制工具"
    tbLeft.Buttons("Camera").ToolTipText = "抓图"
    tbLeft.Buttons("About").ToolTipText = "关于"
    
End Sub
Private Sub tbLeft_ButtonClick(ByVal Button As MSComctlLib.Button)

'Debug.Print Button.Key
    Select Case Button.Key  'handle tb click events
        Case "OpenFile"
            Call GetDataFile
        
        Case "DownLoad"
            frmDownLoad.Show 1, Me
        Case "ReDraw"
            Call ChartBoxDraw
        
        Case "IncBarSpace"
            If fClickingBarSpacing = True Or IsDrawing = True Then Exit Sub
            fClickingBarSpacing = True
            If iBarSpacing < 30 Then
                iBarSpacing = iBarSpacing + 1
            End If
            iCalcdAvailBars2Plot = (Int(rRightSideOffset / iBarSpacing) + 1)
            WriteIni sINIsetFile, "Settings", "BarSpacing", CStr(iBarSpacing)
            Call ChartBoxDraw
        
        Case "DecBarSpace"
            If fClickingBarSpacing = True Or IsDrawing = True Then Exit Sub
            fClickingBarSpacing = True
            If iBarSpacing > 1 Then
                iBarSpacing = iBarSpacing - 1
            End If
            iCalcdAvailBars2Plot = (Int(rRightSideOffset / iBarSpacing) + 1)
            WriteIni sINIsetFile, "Settings", "BarSpacing", CStr(iBarSpacing)
            Call ChartBoxDraw
        
        Case "ScrollData"
            'need to catch the right button click in the mouse up event

        Case "Options"
            Call GetOptionsDlg
        
        Case "Indicators"
            frmIndicators.Show 1, Me
        
        Case "DrawingTools"
            Set objDrawingTools = DrawingTools
            frmDrawingTools.Show 1, Me
            Set objDrawingTools = Nothing
        
        Case "Camera"
            Call CheckForSnapDir
            Call GetAndSaveSnapShot
        
        Case "About"
            frmAbout.Show 0, Me
    End Select
        
End Sub

Private Sub tbLeft_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    'It's an ugly hack to get the right mouse click on the toolbar but since the click
    'won't handle right buttons and it fires after the mouseUp event so we need
    'to find the x-y coord. for the button and determine if is the one we want....
'Debug.Print "X:"; x; " y:"; y
'Debug.Print tbLeft.Buttons("ScrollData").Top; " "; tbLeft.Buttons("ScrollData").Top + tbLeft.Buttons("ScrollData").Height

    If y > tbLeft.Buttons("ScrollData").Top And _
        y < tbLeft.Buttons("ScrollData").Top + tbLeft.Buttons("ScrollData").Height Then
        If Shift Then  'shift button pressed.. large incr.
            If Button = 1 Then
                iScrolledAmount = iScrolledAmount + iScrollIncrement
            ElseIf Button = 2 Then
                iScrolledAmount = iScrolledAmount - iScrollIncrement
            End If
        Else  'normal 1 bar scroll increment
            If Button = 1 Then
                iScrolledAmount = iScrolledAmount + 1
            ElseIf Button = 2 Then
                iScrolledAmount = iScrolledAmount - 1
            End If
        End If
        If iScrolledAmount < 0 Then
            iScrolledAmount = 0
'        ElseIf iScrolledAmount > (iUBaData - iScrolledAmount) - iCalcdAvailBars2Plot Then
'            iScrolledAmount = (iUBaData - iScrolledAmount) - iCalcdAvailBars2Plot
        ElseIf iScrolledAmount > iUBaData - iCalcdAvailBars2Plot Then
            iScrolledAmount = iUBaData - iCalcdAvailBars2Plot
        End If
        Call ChartBoxDraw
        
        'check if button needs to be dis/enabled
        If iScrolledAmount = 0 And iUBaData - iCalcdAvailBars2Plot <= 0 Then
            tbLeft.Buttons("ScrollData").Enabled = False 'nothing to scroll
        Else
            tbLeft.Buttons("ScrollData").Enabled = True 'need to be able to scroll back
        End If
 
    End If
End Sub
Private Sub CheckForSnapDir()
    Dim sPath As String
    sPath$ = App.Path & "\Snaps"   ' Set the path.
    If Dir(sPath$, vbDirectory) = sEmpty$ Then 'not found... make
        MkDir sPath$
    End If
End Sub
Private Sub GetOptionsDlg()
    frmOptions.Show 1, Me
    Call GetIniSettings  'get any new settings
    Call SetColors
    Call SetMargins
    Call ChartBoxDraw
End Sub

Private Sub GetDataFile()
    Static fIn As Boolean
    If fIn Then Exit Sub  'stop DblClk on the toolbar from bring up the open dlg twice
    fIn = True
    sSymbol$ = sEmpty
    If Not OpenDataFile Then fIn = False: Exit Sub
    Call LoadData
    Call SetMargins
    Call ChartBoxDraw
    fKillSplash = True  'flag to unload splash/progress
    fIn = False  'ok to run again
End Sub