frmoptions.frm

枕善居汉化的stockchart股软 描 述：实时股票图表曲线示例 Ver 1.0 网 站：http://www.mndsoft.com/ e-mail ：[e-mail] 最新的

            Call DrawHiLiteBox(picTypeHLOC)
        Case ttCandle
            Call DrawState(picTypeCandle.hDC, 0, 0, picTypeCandle.Picture, 0, 0, 0, 0, 0, DST_ICON)
            Call DrawHiLiteBox(picTypeCandle)
    End Select
    picTypeLine.Refresh
    picTypeHLOC.Refresh
    picTypeCandle.Refresh
End Sub
Private Sub DrawHiLiteBox(pb As PictureBox)
    Dim iOldPen As Long, iHndPen As Long
    
    iHndPen = CreatePen(PS_Solid, 2, vbRed)
    iOldPen = SelectObject(picBarTypeCont.hDC, iHndPen)

    Call Rectangle(picBarTypeCont.hDC, (pb.Left - 2), _
                            (pb.Top - 2), _
                            (pb.Left + pb.Width + 2), _
                            (pb.Top + pb.Height + 2))
    Call SelectObject(picBarTypeCont.hDC, iOldPen)

End Sub
Private Sub DrawBarTypeButtonUp(pb As PictureBox)
    rc1.Left = pb.Left
    rc1.Top = pb.Top
    rc1.Right = pb.Left + pb.Width
    rc1.Bottom = pb.Top + pb.Height
    
    Call InflateRect(rc1, 5, 5)
    Call DrawEdge(picBarTypeCont.hDC, rc1, EDGE_RAISED, BF_TOPLEFT)
    Call DrawEdge(picBarTypeCont.hDC, rc1, EDGE_RAISED, BF_BOTTOMRIGHT)
    picBarTypeCont.Refresh
    fBarTypeButtonDn = True
End Sub
Private Sub DrawBarTypeButtonDn(pb As PictureBox)
    rc1.Left = pb.Left
    rc1.Top = pb.Top
    rc1.Right = pb.Left + pb.Width
    rc1.Bottom = pb.Top + pb.Height
    
    Call InflateRect(rc1, 5, 5)
    Call DrawEdge(picBarTypeCont.hDC, rc1, EDGE_SUNKEN, BF_TOPLEFT)
    Call DrawEdge(picBarTypeCont.hDC, rc1, EDGE_SUNKEN, BF_BOTTOMRIGHT)
    picBarTypeCont.Refresh
    Delay 0.3
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    If fBarTypeButtonDn Then
        picBarTypeCont.Cls
        Call DrawTicType
        fBarTypeButtonDn = False
    End If
End Sub

Private Sub Form_Paint()
    Call DrawTicType
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Set frmOptions = Nothing
End Sub

Private Sub lblColor_Click(Index As Integer)
    
    Select Case Index
        Case 0
            iBackColor = GetColorDlg(iBackColor)
            lblColor(0).BackColor = iBackColor
        Case 1
            iForeColor = GetColorDlg(iForeColor)
            lblColor(1).BackColor = iForeColor
            txtFont.ForeColor = iForeColor
        Case 2
            iGridColor = GetColorDlg(iGridColor)
            lblColor(2).BackColor = iGridColor
        Case 3
            iCrossHairColor = GetColorDlg(iCrossHairColor)
            lblColor(3).BackColor = iCrossHairColor
        Case 4
            iDateMarkerColor = GetColorDlg(iDateMarkerColor)
            lblColor(4).BackColor = iDateMarkerColor
        Case 5
            iTicBodyColor = GetColorDlg(iTicBodyColor)
            lblColor(5).BackColor = iTicBodyColor
        Case 6
            iTicOpenColor = GetColorDlg(iTicOpenColor)
            lblColor(6).BackColor = iTicOpenColor
        Case 7
            iTicCloseColor = GetColorDlg(iTicCloseColor)
            lblColor(7).BackColor = iTicCloseColor
        Case 8
            iTicCandleUpColor = GetColorDlg(iTicCandleUpColor)
            lblColor(8).BackColor = iTicCandleUpColor
        Case 9
            iTicCandleDnColor = GetColorDlg(iTicCandleDnColor)
            lblColor(9).BackColor = iTicCandleDnColor
        Case 10
            iVolColor = GetColorDlg(iVolColor)
            lblColor(10).BackColor = iVolColor
            
    End Select
    Call frmMain.SetColors
    Call frmMain.ChartBoxDraw
End Sub

Private Sub picBarTypeCont_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    If fBarTypeButtonDn Then
        picBarTypeCont.Cls
        Call DrawTicType
        fBarTypeButtonDn = False
    End If
End Sub

Private Sub picTypeCandle_Click()
    iTicType = ttCandle
    Call DrawBarTypeButtonDn(picTypeCandle)
    Call DrawTicType
    Call DrawBarTypeButtonUp(picTypeCandle)
    Call frmMain.ChartBoxDraw
End Sub

Private Sub picTypeCandle_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    If fBarTypeButtonDn Then Exit Sub  'Prevent some flicker
    Call DrawBarTypeButtonUp(picTypeCandle)
End Sub

Private Sub picTypeHLOC_Click()
    iTicType = ttHLOC
    Call DrawBarTypeButtonDn(picTypeHLOC)
    Call DrawTicType
    Call DrawBarTypeButtonUp(picTypeHLOC)
    Call frmMain.ChartBoxDraw
End Sub

Private Sub picTypeHLOC_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    If fBarTypeButtonDn Then Exit Sub  'Prevent some flicker
    Call DrawBarTypeButtonUp(picTypeHLOC)
End Sub

Private Sub picTypeLine_Click()
    iTicType = ttLine
    Call DrawBarTypeButtonDn(picTypeLine)
    Call DrawTicType
    Call DrawBarTypeButtonUp(picTypeLine)
    Call frmMain.ChartBoxDraw
End Sub

Private Sub picTypeLine_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    If fBarTypeButtonDn Then Exit Sub  'Prevent some flicker
    Call DrawBarTypeButtonUp(picTypeLine)
End Sub

Private Sub txtCrosshairMode_Change()
    If Len(txtCrosshairMode.Text) = 2 And txtCrosshairMode.SelLength < 2 Then
        txtCrosshairMode.Text = Right$(txtCrosshairMode.Text, 2) 'don't allow a len value > 2
    End If
    If Val(txtCrosshairMode.Text) > 15 Then
        txtCrosshairMode.Text = 15
    ElseIf Val(txtCrosshairMode.Text) < 1 And Len(txtCrosshairMode.Text) > 0 Then
        txtCrosshairMode.Text = 1
    End If
    
End Sub
Private Sub txtCrosshairMode_Click()
    txtCrosshairMode.SelStart = 0
    txtCrosshairMode.SelLength = Len(txtCrosshairMode.Text)
End Sub
Private Sub txtCrosshairMode_KeyDown(KeyCode As Integer, Shift As Integer)
    
'Debug.Print KeyCode
    Select Case KeyCode
        Case 48 To 57, vbKeyDelete, vbKeyLeft, vbKeyRight, vbKeyBack   ' numerical, delete, r-l arrows, backspace
            'do nothing
        Case vbKeyEscape
            txtCrosshairMode.Text = iCrossHairMode
            txtCrosshairMode.SelStart = Len(txtCrosshairMode.Text)
        Case vbKeyReturn
            If Val(txtCrosshairMode.Text) = 0 Then
                iCrossHairMode = 15
            Else
                iCrossHairMode = Val(txtCrosshairMode.Text)
            End If
        Case Else
            KeyCode = 0
    End Select
End Sub


Private Sub txtDiv1_Click()
    txtDiv1.SelStart = 0
    txtDiv1.SelLength = Len(txtDiv1.Text)
End Sub
Private Sub txtDiv1_KeyDown(KeyCode As Integer, Shift As Integer)

'Debug.Print KeyCode
    Select Case KeyCode
        Case 48 To 57, vbKeyDelete, vbKeyLeft, vbKeyRight, vbKeyBack  ' numerical, delete, r-l arrows, backspace
            'do nothing
        Case vbKeyEscape
            txtDiv1.Text = rSplit1
            txtDiv1.SelStart = Len(txtDiv1.Text)
        Case vbKeyReturn
            If Val(txtDiv1.Text) > 0 Then
                If Val(txtDiv1.Text) > rSplit2 - 10 Then 'set the min & max values
                    txtDiv1.Text = rSplit2 - 10
                ElseIf Val(txtDiv1.Text) < iBottomPlotMargin / 2 And Len(txtDiv1.Text) > 0 Then
                    txtDiv1.Text = iBottomPlotMargin / 2
                End If
                rSplit1 = Val(txtDiv1.Text)
                Call frmMain.SetMargins
                Call frmMain.ChartBoxDraw
            End If
        Case Else
            KeyCode = 0
    End Select
End Sub

Private Sub txtDiv2_Click()
    txtDiv2.SelStart = 0
    txtDiv2.SelLength = Len(txtDiv2.Text)
End Sub
Private Sub txtDiv2_KeyDown(KeyCode As Integer, Shift As Integer)
    'Debug.Print KeyCode
    Select Case KeyCode
        Case 48 To 57, vbKeyDelete, vbKeyLeft, vbKeyRight, vbKeyBack  ' numerical, delete, r-l arrows, backspace
            'do nothing
        Case vbKeyEscape
            txtDiv2.Text = rSplit2
            txtDiv2.SelStart = Len(txtDiv2.Text)
        Case vbKeyReturn
            If Val(txtDiv2.Text) > 0 Then
                If Val(txtDiv2.Text) < rSplit1 + 10 Then 'set the min & max values
                    txtDiv2.Text = rSplit1 + 10
                ElseIf Val(txtDiv2.Text) > iBottomPlotMargin - 50 And Len(txtDiv2.Text) > 0 Then
                    txtDiv2.Text = iBottomPlotMargin - 50
                End If
                rSplit2 = Val(txtDiv2.Text)
                Call frmMain.SetMargins
                Call frmMain.ChartBoxDraw
            End If
        Case Else
            KeyCode = 0
    End Select
End Sub

Private Sub SetUpFontTb()
    
    txtFont.ForeColor = iForeColor
    txtFont.BackColor = iBackColor
    Set txtFont.Font = frmMain.ChartBox.Font
    txtFont.FontBold = iFontBold
    txtFont.FontItalic = iFontItalic
    txtFont.Text = txtFont.FontName & vbCrLf & txtFont.FontSize & " pts " _
                        & IIf(txtFont.FontBold, "Bold ", sEmpty) _
                        & IIf(txtFont.FontItalic, "Italic", sEmpty)
End Sub
Private Sub txtFont_Click()
    Static fIn As Boolean
    If fIn Then Exit Sub 'prevent more than 1 procedure run at a time
    fIn = True
    Dim f As Boolean, fnt As StdFont, clr As Long
    Set fnt = frmMain.ChartBox.Font
    'clr = iForeColor
    fnt.Bold = iFontBold
    fnt.Italic = iFontItalic

    CenterDlgBox 0
    'effects are disabled... don't need underline and strikethough for legion text anyway
    f = VBChooseFont(CurFont:=fnt, _
                         flags:=CF_BOTH)
    'f = VBChooseFont(CurFont:=fnt, _
                         Color:=clr, _
                         Flags:=CF_EFFECTS Or CF_BOTH)

    If f Then
        Set frmMain.ChartBox.Font = fnt
        sFontName = fnt
        iFontSize = fnt.Size
        'using the font selector only gives 16 colors for text color
        'Note: with black backcolor the text would disappear when changing the font.
        'I twisted my brain trying to figure out why. The font dlg
        'won't show the current color sent to it during init. Always
        'came up 0 (=black) ... eventually I found that it would if one of the 16 colors
        'finally decided to diable the font selector text color color so all colors
        'could be used for the text color
        
        'If clr <> iBackColor Then _
            iForeColor = clr
                
        iFontBold = fnt.Bold
        iFontItalic = fnt.Italic
        Call SetUpFontTb
        Call frmMain.SetColors
        Call frmMain.SetMargins
        Call frmMain.ChartBoxDraw
    End If
    cmdTakeFocus.SetFocus
    fIn = False
End Sub

Private Sub tmrAfterLoad_Timer()
    tmrAfterLoad.Enabled = False
    Call PositionMousePointer(cmdcancel.hWnd, cmdcancel.Width \ 2, cmdcancel.Height / 1.2)
End Sub

Private Sub txtScrollIncrement_Change()
    If Len(txtScrollIncrement.Text) = 2 And txtScrollIncrement.SelLength < 2 Then
        txtScrollIncrement.Text = Right$(txtScrollIncrement.Text, 2) 'don't allow a len value > 2
    End If
    If Val(txtScrollIncrement.Text) > 10 Then
        txtScrollIncrement.Text = 10
    ElseIf Val(txtScrollIncrement.Text) < 10 And Len(txtScrollIncrement.Text) > 0 Then
        txtScrollIncrement.Text = 10
    End If
    
End Sub
Private Sub txtScrollIncrement_Click()
    txtScrollIncrement.SelStart = 0
    txtScrollIncrement.SelLength = Len(txtScrollIncrement.Text)
End Sub
Private Sub txtScrollIncrement_KeyDown(KeyCode As Integer, Shift As Integer)
    
'Debug.Print KeyCode
    Select Case KeyCode
        Case 48 To 57, vbKeyDelete, vbKeyLeft, vbKeyRight, vbKeyBack   ' numerical, delete, r-l arrows, backspace
            'do nothing
        Case vbKeyEscape
            txtScrollIncrement.Text = iCrossHairMode
            txtScrollIncrement.SelStart = Len(txtScrollIncrement.Text)
        Case vbKeyReturn
            If Val(txtScrollIncrement.Text) = 0 Then
                iCrossHairMode = 15
            Else
                iCrossHairMode = Val(txtScrollIncrement.Text)
            End If
        Case Else
            KeyCode = 0
    End Select
End Sub