- 金字塔客服中心 - 专业程序化交易软件提供商 (http://weistock.com/bbs/index.asp)
-- 高级功能研发区 (http://weistock.com/bbs/list.asp?boardid=5)
---- 等价K线代码(原创） (http://weistock.com/bbs/dispbbs.asp?boardid=5&id=50621)
-- 发布时间：2013/4/3 14:14:54
-- 等价K线代码(原创）
\'-------------------------------------------------------------等价K开始---------------------------------------------------
dim shanchu
shanchu = 0 \'是否删除历史数据，1为需要
dim dangtianshuju \'当日是否有数据，0为没有
dangtianshuju = 1
dim bili
bili = 0.001 \'等价线区间
dim xinheyue
xinheyue = "IF88" \'新等价K合约代码
dim xinmingcheng
xinmingcheng = "IF等价K线" \'新等价K合约名称
dim xinshichang
xinshichang = "ZJ" \'新等价K合约市场
dim laoheyue
laoheyue = "IF00" \'标的合约代码
dim laoshichang
laoshichang = "ZJ" \'标的合约市场
dim laozhishu
laozhishu = "IF13"
Sub lishishuju()
\'查询品种是否存在，不存在则新建
cunzai = marketdata.IsExistStock(xinheyue,xinshichang)
if cunzai = 0 then
call marketdata.AddStock(xinheyue,xinshichang, xinmingcheng)
application.MsgOut "等价K线【创建成功】！"
else
application.MsgOut "等价K线【已经存在】！"
end if
\'等价区间处理
set Report1 = marketdata.GetReportData(laoheyue,laoshichang)
qj = Report1.Open*bili
\'删除历史数据，创建第一根K线
if shanchu = 1 then
Set History1 = marketdata.GetHistoryData(xinheyue,xinshichang,0)
for j = 0 to History1.Count-1
History1.RemoveAt(j)
next
call History1.InsertAt(0)
History1.open(0) = Report1.Open
History1.close(0) = Report1.Open
History1.high(0) = Report1.Open
History1.low(0) = Report1.Open
History1.Date(0) = Report1.Date
History1.Volume(0) = Report1.Volume
History1.OpenInt(0) = Report1.OpenInt
call History1.SaveData(xinheyue,xinshichang,1)
application.MsgOut "等价K线【历史数据初始化】成功！"
end if
set minutedata = marketdata.GetMinuteData(laoheyue,laoshichang)
Count = minutedata.Count
for i = 1 to count-1
Set History2 = marketdata.GetHistoryData(xinheyue,xinshichang,0)
mxopen = History2.open(History2.Count-1)
mxclose = History2.close(History2.Count-1)
mxhigh = History2.high(History2.Count-1)
mxlow = History2.low(History2.Count-1)
mxDate = History2.Date(History2.Count-1)
mxVolume = History2.Volume(History2.Count-1)
mxOpenInt = History2.OpenInt(History2.Count-1)
close = minutedata.newprice(i)
fbDate = minutedata.Date(i)
Volume = minutedata.Volume(i)
mxVolume = minutedata.Volume(i-1)
OpenInt = minutedata.OpenInt(i)
if close > mxhigh then mxhigh = close end if
if close < mxlow then mxlow = close end if
mxdate = fbDate
mxxVolume = (Volume-mxVolume)+mxxVolume
mxOpenInt = OpenInt
History2.close(History2.Count-1) = close
History2.high(History2.Count-1) = mxhigh
History2.low(History2.Count-1) = mxlow
History2.Date(History2.Count-1) = mxdate
History2.Volume(History2.Count-1) = mxxVolume
History2.OpenInt(History2.Count-1) = mxOpenInt
call History2.SaveData(xinheyue,xinshichang,1)
if abs(close-mxopen) > qj then
\'新建一个K线
call History2.InsertAt(History2.Count)
History2.open(History2.Count-1) = close
History2.close(History2.Count-1) = close
History2.high(History2.Count-1) = close
History2.low(History2.Count-1) = close
History2.Date(History2.Count-1) = mxdate
History2.Volume(History2.Count-1) = 0
History2.OpenInt(History2.Count-1) = OpenInt
call History2.SaveData(xinheyue,xinshichang,1)
mxxVolume = 0
end if
next
End Sub
sub dengjiaK()‘第一次用的时候请先运行改宏创建等价K线数据
call lishishuju()
end sub
Sub APPLICATION_VBAStart()
call Application.SetTimer(0,1000) \'创建一个0号定时器，间隔时间1秒
End Sub
Sub APPLICATION_Timer(ID)
if ID = 0 then
if (cdate(time)<=cdate("11:30:00") and cdate(time)>cdate("9:15:00")) or (cdate(time)<=cdate("15:15:00") and cdate(time)>cdate("13:00:00")) then
\'等价区间处理
set Report1 = marketdata.GetReportData(laoheyue,laoshichang)
qj = Report1.Open*bili
set Report2 = marketdata.GetReportData(laozhishu,laoshichang)
Set History2 = marketdata.GetHistoryData(xinheyue,xinshichang,0)
mxopen = History2.open(History2.Count-1)
mxclose = History2.close(History2.Count-1)
mxhigh = History2.high(History2.Count-1)
mxlow = History2.low(History2.Count-1)
mxDate = History2.Date(History2.Count-1)
mxxVolume = History2.Volume(History2.Count-1)
mxOpenInt = History2.OpenInt(History2.Count-1)
set minutedata = marketdata.GetMinuteData(laoheyue,laoshichang)
Count = minutedata.Count
close = minutedata.newprice(Count-1)
fbDate = minutedata.Date(Count-1)
mxVolume = minutedata.Volume(Count-2)
Volume = minutedata.Volume(Count-1)
OpenInt = minutedata.OpenInt(Count-1)
if close > mxhigh then mxhigh = close end if
if close < mxlow then mxlow = close end if
mxdate = fbDate
mxxVolume = mxxVolume+(Volume-mxVolume)
mxOpenInt =OpenInt
\' application.MsgOut mxxVolume&" "&Volume&" "&Volume-mxVolume
History2.close(History2.Count-1) = close
History2.high(History2.Count-1) = mxhigh
History2.low(History2.Count-1) = mxlow
History2.Date(History2.Count-1) = mxdate
History2.Volume(History2.Count-1) = mxxVolume
History2.OpenInt(History2.Count-1) = mxOpenInt
call History2.SaveData(xinheyue,xinshichang,1)
if abs(close-mxopen) > qj then
\'新建一个K线
call History2.InsertAt(History2.Count)
History2.open(History2.Count-1) = close
History2.close(History2.Count-1) = close
History2.high(History2.Count-1) = close
History2.low(History2.Count-1) = close
History2.Date(History2.Count-1) = mxdate
History2.Volume(History2.Count-1) = 0
History2.OpenInt(History2.Count-1) = OpenInt
call History2.SaveData(xinheyue,xinshichang,1)
mxxVolume = 0
end if
call Application.ActivateFrameWithCode("Technic",xinheyue,xinshichang,0)
call Technic.Refresh
end if
end if
end sub
Sub to_0()
\'得到上期所指定品种的日线数据
Set History = marketdata.GetHistoryData("IF88","ZJ",0)
\'删掉第一条数据
for i=0 to History.Count-1
History.Volume(i) = 0
next
call History.SaveData("IF88","ZJ",1)
End Sub
-- 发布时间：2013/4/3 14:19:51
--
好东西
-- 发布时间：2013/4/3 14:33:19
--
-- 发布时间：2013/4/3 14:35:49
--
上效果图
-- 发布时间：2013/4/3 15:22:26
--
..这样的代码放在哪用呢
-- 发布时间：2013/4/7 14:58:07
--
不错的。
-- 发布时间：2013/4/7 21:59:01
--
超级牛的
-- 发布时间：2013/4/14 14:57:00
--
有什么用呢？
-- 发布时间：2013/4/15 22:18:35
--
看起来很美丽，慢慢研究一下。
-- 发布时间：2013/4/17 0:51:22
--
极度佩服中。我也想自制窗格，自制K线图，不见得是等价的思路，然后可直接加载公式，可回撤，可刷新，可交易。苦于一点VBA基础都没有，现看到一线曙光了。