mfunctions.bas

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

        GetColorDlg = iColor
    Else
        GetColorDlg = iPrevColor
    End If

End Function
Public Function OpenDataFile() As Boolean
    Dim f As Boolean, sFile As String
    
    CenterDlgBox 0
    f = VBGetOpenFileName( _
            FileName:=sFile$, _
            ReadOnly:=False, _
            filter:="Data Files (*.dat): *.dat|All files (*.*): *.*", _
            DefaultExt:="*.dat", _
            FilterIndex:=1, _
            DlgTitle:="Open Data File", _
            owner:=0, InitDir:=sDataDir$)
    If f And sFile$ <> sEmpty Then
        sFilePath$ = sFile$
        WriteIni sINIsetFile, "Settings", "LastFile", sFilePath$
        sFileName$ = GetFileBaseExt(sFile$)
        Dim p As Long
        p = InStr(sFileName$, "~")  'check for symbol in file name
        If p <> 0 Then
            sSymbol$ = Left$(sFileName$, p - 1)
        Else  'not found...
            sSymbol$ = sUnknownSymbol$
        End If
        WriteIni sINIsetFile, "DataInfo", "Symbol", sSymbol$
    End If
    OpenDataFile = f
End Function
Public Function LoadData() As Boolean
    
    Dim x As Integer, i As Integer, y As Integer, c As Integer, ff As Integer, fSkipLine As Boolean
    Dim sLineFromFile As String, stoken As String, sTemp As String, iType As Integer
    
    If IsDrawing = True Then Exit Function  'if we're drawing a chart exit this function
            
    If Not ExistFile(sFilePath$) Then
        If OpenDataFile = False Then 'cancelled
            Exit Function
        Else 'new file
            
        End If
    End If
    
    If Not frmSplash.Visible Then frmSplash.Show 0, frmMain
    
    ff = FreeFile
    Open sFilePath$ For Input Access Read As ff
    
    Do While Not EOF(ff)
        DoEvents
            Line Input #ff, sLineFromFile$
            If Len(sLineFromFile$) > 2 Then c = c + 1 'line count, make sure not a blank
            If c = 1 Then
                'check the first line for data config
                Select Case sLineFromFile$
                    Case """Date"",""O"",""H"",""L"",""C"",""V"""
                        iType = 1   'typical end of day format
                    Case """Date"",""Time"",""O"",""H"",""L"",""C"",""V"""
                        iType = 2  'Typical intraday format
                    Case """Date"",""Time"",""O"",""H"",""L"",""C"",""U"",""D"""
                        iType = 3  'Omega format
                    Case "Date,Open,High,Low,Close,Volume"
                        iType = 1 'Yahoo EOD format
                    
                End Select
            End If
    Loop
    Close ff
'Debug.Print "c: "; c
    iUBaData = c - 1
    If iType <> 0 Then
        iUBaData = iUBaData - 1  'subtract first line from total
        fSkipLine = True  'set flag to skip the first line
    End If
    ReDim aData(0 To iUBaData)
    
    'parse the data
    Open sFilePath$ For Input Access Read As ff
    Do While Not EOF(ff)
        DoEvents
        Line Input #ff, sLineFromFile$
        If Not fSkipLine And Len(sLineFromFile$) > 2 Then
        
            stoken$ = GetQToken(sLineFromFile$, ",")
            Do While stoken$ <> sEmpty$
'Debug.Print stoken
                Select Case y
                    Case 0  'Date
'Debug.Print stoken
                        aData(x).sDate = stoken$
                        If iType = 1 Then  'no time in this config so we need to bump y +1
                            y = y + 1
                        End If
                    Case 1  'time
                        If Left(stoken$, 3) <> ":" Then _
                            sTemp$ = Left(stoken$, 2) & ":" & Right(stoken$, 2)
                        aData(x).sTime = sTemp$
                    Case 2  ' open
                        aData(x).dOpen = Round(Val(stoken$), 3)
                    Case 3  ' high
                        aData(x).dHigh = Round(Val(stoken$), 3)
                    Case 4  ' low
                        aData(x).dLow = Round(Val(stoken$), 3)
                    Case 5  ' close
                        aData(x).dClose = Round(Val(stoken$), 3)
                    Case 6  ' vol.
                        aData(x).iVol = Val(stoken$)
                    Case 7
                        'Omega data has the vol split into up & dn vol-> add it
                        If iType = 3 Then aData(x).iVol = aData(x).iVol + Val(stoken$)
                    Case Else
'Debug.Print "CaseElse"

                End Select
                y = y + 1
'Debug.Print "y: "; y
                stoken$ = GetQToken(sEmpty$, ",")
            Loop
            x = x + 1
        End If
        fSkipLine = False  'set flag so we can get input lines
        y = 0
    Loop
    Close ff
    
    Call CalculateDataPeriod
    LoadData = True
    
End Function
Private Sub CalculateDataPeriod()
    '*******************Calculate time between data entries
    Dim i1H As Integer, i2H As Integer, i1M As Integer, i2M As Integer
    Dim sTime As String, sTime2 As String, iDifH As Integer, iDifM As Integer
    
    sTime$ = aData(iUBaData).sTime
    sTime2$ = aData(iUBaData - 1).sTime
    'sTime$ = Trim$(Mid$(sTime$, InStr(sTime$, " ") + 1))
    'sTime2$ = Trim$(Mid$(sTime2$, InStr(sTime2$, " ") + 1))
'Debug.Print stime$
'Debug.Print stime2$
    If sTime$ = sTime2$ Then  'daily data
'Debug.Print DateDiff("d", aData(iUBaData - 1).sDate, aData(iUBaData).sDate)
        If DateDiff("d", aData(iUBaData - 1).sDate, aData(iUBaData).sDate) > 3 Then
            iBarDataPeriodMins = -2  'weekly or other
        Else
            iBarDataPeriodMins = -1  'daily
        End If
        Exit Sub
    End If
    i1H = Val(Left$(sTime$, InStr(sTime$, ":") - 1))
    i1M = Val(Mid$(sTime$, InStr(sTime$, ":") + 1))
'Debug.Print i1H; "  "; i1M
    
    i2H = Val(Left$(sTime2$, InStr(sTime2$, ":") - 1))
    i2M = Val(Mid$(sTime2$, InStr(sTime2$, ":") + 1))
    
    iDifH = i1H - i2H
    iDifM = i1M - i2M
'Debug.Print iDifH; "  "; iDifM
    
    iBarDataPeriodMins = iDifH * 60 + iDifM
    
End Sub
Public Sub CenterDlgBox(frmHwnd As Long)
    
    Dim hInst As Long
    Dim Thread As Long

   'Set up the CBT hook
   lFrmHwndCntrMsgBox = frmHwnd
   hInst = GetWindowLong(frmHwnd, GWL_HINSTANCE)
   Thread = GetCurrentThreadId()
   hHookCntrMsgBox = SetWindowsHookEx(WH_CBT, AddressOf CntrMsgBox, hInst, _
                            Thread)
    
End Sub
Private Function CntrMsgBox(ByVal lMsg As Long, ByVal wParam As Long, _
   ByVal lParam As Long) As Long

    Dim rectForm As RECT, rectMsg As RECT
    Dim x As Long, y As Long

   'On HCBT_ACTIVATE, show the MsgBox centered over Form1
   If lMsg = HCBT_ACTIVATE Then
      'Get the coordinates of the form and the message box so that
      'you can determine where the center of the form is located
      If lFrmHwndCntrMsgBox <> 0 Then
        GetWindowRect lFrmHwndCntrMsgBox, rectForm
        GetWindowRect wParam, rectMsg
        x = (rectForm.Left + (rectForm.Right - rectForm.Left) / 2) - _
            ((rectMsg.Right - rectMsg.Left) / 2)
        y = (rectForm.Top + (rectForm.Bottom - rectForm.Top) / 2) - _
            ((rectMsg.Bottom - rectMsg.Top) / 2)
      Else
        GetWindowRect GetDesktopWindow, rectForm
        GetWindowRect wParam, rectMsg
        x = (rectForm.Left + (rectForm.Right - rectForm.Left) / 2) - _
            ((rectMsg.Right - rectMsg.Left) / 2)
        y = (rectForm.Top + (rectForm.Bottom - rectForm.Top) / 2) - _
            ((rectMsg.Bottom - rectMsg.Top) / 2)
      End If
      
      'Position the msgbox
      SetWindowPos wParam, 0, x, y, 0, 0, _
                   SWP_NOSIZE Or SWP_NOZORDER Or SWP_NOACTIVATE
      'Release the CBT hook
      UnhookWindowsHookEx hHookCntrMsgBox
   End If
   CntrMsgBox = False

End Function

Public Sub Delay(rSeconds As Single)
    Dim rDelay As Single
    rDelay = Timer
    Do Until Timer - rDelay > rSeconds
        DoEvents
    Loop
End Sub
Public Sub PositionMousePointer(ByVal ihWnd As Long, iXoffsetFromLeft As Long, iYoffsetFromTop As Long, Optional isPixels As Boolean = True)
    'send mouse to specified position... AKA hotspot
    Dim recReturn As RECT, iX As Long, iY As Long
    Call GetWindowRect(ihWnd, recReturn)
    If isPixels = True Then
        iX = recReturn.Left + iXoffsetFromLeft
        iY = recReturn.Top + iYoffsetFromTop
    Else
        iX = recReturn.Left + iXoffsetFromLeft \ Screen.TwipsPerPixelX
        iY = recReturn.Top + iYoffsetFromTop \ Screen.TwipsPerPixelY
    End If
    Call SetCursorPos(iX, iY)

End Sub
Public Sub SaveBmp2File(bi24BitInfo As BITMAPINFO, bBytes() As Byte)
    Dim BmpHeader As BITMAPFILEHEADER, sOutFile As String
    
    sOutFile$ = App.Path & "\Snaps\Snap" & Format(Now, "[e-mail]/p") & ".bmp"

    With BmpHeader
        .bfType = &H4D42
        .bfOffBits = Len(BmpHeader) + Len(bi24BitInfo.bmiHeader)
        .bfSize = .bfOffBits + bi24BitInfo.bmiHeader.biSizeImage
    End With
    Open sOutFile$ For Binary As #29
        Put #29, , BmpHeader
        Put #29, , bi24BitInfo.bmiHeader
        Put #29, , bBytes()
    Close #29
End Sub