?? mfunctions.bas
字號:
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, "mmddyyyy@hh.mm.ssa/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
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -