?? main.frm
字號:
'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
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -