| 网站首页 | 业界新闻 | 小组 | 威客 | 人才 | 下载频道 | 博客 | 代码贴 | 在线编程 | 编程论坛
欢迎加入我们,一同切磋技术
用户名:   
 
密 码:  
共有 1636 人关注过本帖
标题:下了个程序看不明白,讲解功能,vb程序几个常用模块
只看楼主 加入收藏
xgwdtx511
Rank: 1
等 级:新手上路
帖 子:10
专家分:0
注 册:2006-5-29
收藏
 问题点数:0 回复次数:9 
下了个程序看不明白,讲解功能,vb程序几个常用模块
最近做毕业设计快要叫论文了,嘿嘿,下列了个程序写报告时却看不明白功能,这个是股票k线分析系统的程序原代码,有高手能帮我把9个模块的独立功能讲解以下吗,无限感激
ps:不一定要全解释,能看明白1个模块的就说一个模块的功能就好
程序原代码:

FrmToR

Private Type SHITEMID 'mkid

cb As Long 'Size of the ID (including cb itself)

abID As Byte 'The item ID (variable length)

End Type

Private Type ITEMIDLIST 'idl

mkid As SHITEMID

End Type

Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long

Private Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" (ByVal hwndOwner As Long, ByVal nFolder As Long, pidl As ITEMIDLIST) As Long

Private Const NOERROR = 0

Private Const CSIDL_DESKTOP = &H0

Private Const CSIDL_PROGRAMS = &H2

Private Const CSIDL_CONTROLS = &H3

Private Const CSIDL_PRINTERS = &H4

Private Const CSIDL_PERSONAL = &H5 ' (Documents folder)

Private Const CSIDL_FAVORITES = &H6

Private Const CSIDL_STARTUP = &H7

Private Const CSIDL_RECENT = &H8 ' (Recent folder)

Private Const CSIDL_SENDTO = &H9

Private Const CSIDL_BITBUCKET = &HA

Private Const CSIDL_STARTMENU = &HB

Private Const CSIDL_DESKTOPDIRECTORY = &H10

Private Const CSIDL_DRIVES = &H11

Private Const CSIDL_NETWORK = &H12

Private Const CSIDL_NETHOOD = &H13

Private Const CSIDL_FONTS = &H14

Private Const CSIDL_TEMPLATES = &H15

Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long 'ITEMIDLIST

Private Type BROWSEINFO 'bi

hOwner As Long

pidlRoot As Long

pszDisplayName As String

lpszTitle As String

ulFlags As Long

lpfn As Long

lParam As Long

iImage As Long

End Type

Private Const BIF_RETURNONLYFSDIRS = &H1

Private Const BIF_DONTGOBELOWDOMAIN = &H2

Private Const BIF_STATUSTEXT = &H4

Private Const BIF_RETURNFSANCESTORS = &H8

Private Const BIF_BROWSEFORCOMPUTER = &H1000

Private Const BIF_BROWSEFORPRINTER = &H2000

Private Sub CmdStart_Click()

Dim sha As ClsDrawLine

Set sha = New ClsDrawLine

For i = 1 To Me.FileSH.ListCount

Next i

End Sub

Private Sub Command1_Click()

Dim bi As BROWSEINFO

Dim idl As ITEMIDLIST

Dim rtn&, pidl&, path$, pos%

bi.hOwner = Me.hwnd

bi.lpszTitle = "Browsing is set to: "

bi.ulFlags = BIF_RETURNONLYFSDIRS

pidl& = SHBrowseForFolder(bi)

path$ = Space$(512)

rtn& = SHGetPathFromIDList(ByVal pidl&, ByVal path$)

If rtn& Then

pos% = InStr(path$, Chr$(0))

Label3.caption = Left(path$, pos - 1)

FileSH.path = Label3.caption + "\data\shase\" + Me.Combo1.Text

FileSZ.path = Label3.caption + "\data\sznse\" + Me.Combo1.Text

End If

End Sub

Private Sub FileSH_Click()

End Sub

Private Sub FileSZ_Click()

End Sub

Private Sub Form_Load()

With Me.Combo1

.AddItem "Day"

.AddItem "Week"

.AddItem "Month"

.ListIndex = 0

End With

End Sub

Private Sub Label1_Click()

End Sub

Private Sub Label1_LinkError(LinkErr As Integer)

End Sub

[此贴子已经被作者于2006-5-29 13:31:40编辑过]

搜索更多相关主题的帖子: 模块 股票 FONT 
2006-05-29 13:11
xgwdtx511
Rank: 1
等 级:新手上路
帖 子:10
专家分:0
注 册:2006-5-29
收藏
得分:0 
功能模块2

FrmSort

Dim DayData(1 To 5000) As TypeDayData

Dim BeginData As Long

Dim EndData As Long

Dim e(1 To 3) As Long

Dim PointValue(1 To 300) As Double

Dim h As Integer

Dim u As Integer

Dim fso As New Scripting.FileSystemObject

Dim fil As Scripting.File

Private Sub Form_Load()

Option1_Click (0)

End Sub

Private Sub Command1_Click()

If Me.DTPicker2.value = "" And Me.DTPicker1.value = "" Then

MsgBox "you should enter a date"

End If

If DateDiff("d", DTPicker2.value, DTPicker2.value) < 0 Then

MsgBox "end date must later then start date"

End If

BeginData = DateConvertToLong(Me.DTPicker1.value)

EndData = DateConvertToLong(Me.DTPicker2.value)

l = 1

For Each fil In fso.GetFolder(App.path + "\data").Files

Open fil.path For Random As #1 Len = Len(DayData(1))

fl = LOF(1) / Len(DayData(1))

For i = 1 To fl

Get #1, , DayData(i)

Next i

Dim r As Long, s As Long

'find begin date

For j = 1 To fl

If DayData(j).this_date >= BeginData Then

kp = DayData(j).kp

r = DayData(j).this_date

Exit For

End If

Next j

'find end date

For k = fl To 1 Step -1

If DayData(k).this_date <= EndData Then

sp = DayData(k).sp

s = DayData(k).this_date

Exit For

End If

Next k

If r > s Or r = 0 Or s = 0 Then

PointValue(l) = 0

Else

PointValue(l) = Int(((sp - kp) / CDbl(kp)) * 100) / 100

End If

l = l + 1

Close #1

Next

merge_sort PointValue, 1, l - 1

Call FileLv1

End Sub

Private Sub DTPicker1_Click()

If Me.DTPicker1.value = "" Then

MsgBox "you should enter a date"

End If

End Sub

Private Sub FileLv1()

Dim itmx As ListItem

ListView1.ListItems.Clear

i = 1

For Each fil In fso.GetFolder(App.path + "\data").Files

Set itmx = ListView1.ListItems.Add()

itmx.Text = fil.Name

ListView1.ListItems(i).ListSubItems.Add = fil.Name

ListView1.ListItems(i).ListSubItems.Add = PointValue(i)

i = i + 1

Next

End Sub

2006-05-29 13:15
xgwdtx511
Rank: 1
等 级:新手上路
帖 子:10
专家分:0
注 册:2006-5-29
收藏
得分:0 

接上个帖子
Private Function DateConvertToLong(TheDate As String) As Long

Dim m As String

b = Split(TheDate, "-", 3)

b(1) = IIf(Val(b(1)) < 10, "0" + b(1), b(1))

b(2) = IIf(Val(b(2)) < 10, "0" + b(2), b(2))

DateConvertToLong = Join(b, "")

End Function

Private Sub Option1_Click(Index As Integer)

Dim itmx As ListItem

LvPoint.ListItems.Clear

Select Case Index

Case 0

Set itmx = LvPoint.ListItems.Add(): itmx.Text = "ZDF": LvPoint.ListItems(1).ListSubItems.Add = "涨跌比"

Set itmx = LvPoint.ListItems.Add(): itmx.Text = "ZF": LvPoint.ListItems(2).ListSubItems.Add = "振幅比"

Set itmx = LvPoint.ListItems.Add(): itmx.Text = "YDB": LvPoint.ListItems(3).ListSubItems.Add = "异动比"

Case 1

Set itmx = LvPoint.ListItems.Add(): itmx.Text = "ZDF": LvPoint.ListItems(1).ListSubItems.Add = "涨跌比"

Set itmx = LvPoint.ListItems.Add(): itmx.Text = "ZF": LvPoint.ListItems(2).ListSubItems.Add = "振幅比"

Set itmx = LvPoint.ListItems.Add(): itmx.Text = "UD": LvPoint.ListItems(3).ListSubItems.Add = "涨跌幅"

Case 2

Set itmx = LvPoint.ListItems.Add(): itmx.Text = "ZDF": LvPoint.ListItems(1).ListSubItems.Add = "涨跌比"

Set itmx = LvPoint.ListItems.Add(): itmx.Text = "ZF": LvPoint.ListItems(2).ListSubItems.Add = "振幅比"

Set itmx = LvPoint.ListItems.Add(): itmx.Text = "UD": LvPoint.ListItems(3).ListSubItems.Add = "涨跌幅"

Case 3

Set itmx = LvPoint.ListItems.Add(): itmx.Text = "ZDF": LvPoint.ListItems(1).ListSubItems.Add = "涨跌比"

Set itmx = LvPoint.ListItems.Add(): itmx.Text = "ZF": LvPoint.ListItems(2).ListSubItems.Add = "振幅比"

Set itmx = LvPoint.ListItems.Add(): itmx.Text = "UD": LvPoint.ListItems(3).ListSubItems.Add = "涨跌幅"

Case 4

Set itmx = LvPoint.ListItems.Add(): itmx.Text = "ZDF": LvPoint.ListItems(1).ListSubItems.Add = "涨跌比"

Set itmx = LvPoint.ListItems.Add(): itmx.Text = "ZF": LvPoint.ListItems(2).ListSubItems.Add = "振幅比"

Set itmx = LvPoint.ListItems.Add(): itmx.Text = "UD": LvPoint.ListItems(3).ListSubItems.Add = "涨跌幅"

End Select

End Sub

2006-05-29 13:15
xgwdtx511
Rank: 1
等 级:新手上路
帖 子:10
专家分:0
注 册:2006-5-29
收藏
得分:0 
功能模块3
FrmKLine

Dim WithEvents KLine As ClsDrawLine

Dim KLineAMT As New ClsDrawLine

Private Sub Form_Load()

'for spliter bar

Me.spliter.set_UpObj Me.PicKLine, 2000

Me.spliter.set_DownObj Me.PicK2, 2000

'fill combo for code

Dim filecode As String

filecode = Dir$(App.path + "\data\*.*")

Do While filecode <> ""

cbocode.AddItem Left(filecode, 6)

filecode = Dir$()

Loop

Set KLine = New ClsDrawLine

KLine.LineStyle = [day k line]

KLine.SetPic Me.PicKLine

KLine.StockFile = App.path + "\data\600038.day"

KLine.DrawLine

KLineAMT.LineStyle = [amount line]

KLineAMT.SetPic Me.PicK2

KLineAMT.StockFile = App.path + "\data\600038.day"

KLineAMT.DrawLine

Me.LblCode = "600038"

Me.LblName = "aaa"

ShowLabel

End Sub

Private Sub ShowLabel()

Me.LblDate = KLine.OneDayData.TheDate

Me.LblMax = KLine.OneDayData.hi / 1000

Me.LblMin = KLine.OneDayData.lo / 1000

Me.LblStart = KLine.OneDayData.kp / 1000

Me.LblEnd = KLine.OneDayData.sp / 1000

Me.LblAmount = KLine.OneDayData.amt / 1000

Me.LblMoney = KLine.OneDayData.num / 1000

End Sub

Private Sub Form_Paint()

Me.PicKLine.SetFocus

End Sub

Private Sub cbocode_KeyPress(KeyAscii As Integer)

' look for a match only if a printable key

matchIt = (KeyAscii = 13)

If matchIt Then

StockFile = App.path + "\data\" + Me.cbocode.Text + ".day"

KLine.StockFile = StockFile

KLine.DrawLine

KLineAMT.StockFile = StockFile

KLineAMT.DrawLine

Me.PicKLine.SetFocus

End If

End Sub

Private Sub cbocode_Click()

cbocode_KeyPress (13)

End Sub

Private Sub cbocode_KeyUp(KeyCode As Integer, Shift As Integer)

' ' if it was a printable key, look for the matching item

If matchIt Then

FindMatchingItem

matchIt = False

End If

End Sub

Private Sub FindMatchingItem()

Dim Text As String

Text = cbocode.Text

If Text = "" Then Exit Sub

If cbocode.SelStart + cbocode.SelLength = Len(Text) Then

Text = Left$(Text, cbocode.SelStart)

End If

If InStr(1, cbocode.List(cbocode.TopIndex), Text, vbTextCompare) = 1 Then

cbocode.Text = cbocode.List(cbocode.TopIndex)

cbocode.SelStart = Len(Text)

cbocode.SelLength = 999

End If

End Sub

Private Sub KLine_KeyDwn()

ShowLabel

KLineAMT.ViewDayWidth = KLine.ViewDayWidth

KLineAMT.ViewStartDayIndex = KLine.ViewStartDayIndex

KLineAMT.ViewEndDayIndex = KLine.ViewEndDayIndex

KLineAMT.DrawLine

End Sub

Private Sub PicKLine_Resize()

KLine.DrawLine

KLineAMT.DrawLine

End Sub

[此贴子已经被作者于2006-5-29 13:17:10编辑过]

2006-05-29 13:16
xgwdtx511
Rank: 1
等 级:新手上路
帖 子:10
专家分:0
注 册:2006-5-29
收藏
得分:0 
功能模块4

Private Sub Form_Resize()

Me.LblTitle.Left = (Me.Width - Me.LblTitle.Width) / 2

ll = (Me.Width - LblItem(0).Width) / 2

LblItem(0).Visible = False

For i = 1 To 10

LblItem(i).Move ll, LblTitle.Top + 100 + LblItem(0).Height * i * 1.5

LblItem(i).Visible = True

Next i

Me.ImgHand.Move Me.LblItem(CurrentMenuList.CurrentPos).Left - 500, Me.LblItem(CurrentMenuList.CurrentPos).Top

End Sub

Public Sub ShowMenuList()

Dim i As Integer

Me.LblTitle.caption = CurrentMenuList.Title

For i = 1 To CurrentMenuList.MenuItemNumber

LblItem(i).caption = CurrentMenuList.MenuItem(i).caption

LblItem(i).Visible = True

Next i

For i = CurrentMenuList.MenuItemNumber + 1 To 10

LblItem(i).caption = ""

Next i

End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)

Select Case KeyCode

Case vbKeyDown

If CurrentMenuList.CurrentPos < CurrentMenuList.MenuItemNumber Then

CurrentMenuList.CurrentPos = CurrentMenuList.CurrentPos + 1

Else

CurrentMenuList.CurrentPos = 1

End If

Case vbKeyUp

If CurrentMenuList.CurrentPos = 1 Then

CurrentMenuList.CurrentPos = CurrentMenuList.MenuItemNumber

Else

CurrentMenuList.CurrentPos = CurrentMenuList.CurrentPos - 1

End If

Case vbKeyReturn

If CurrentMenuList.MenuItem(CurrentMenuList.CurrentPos).FormOrMenulist = True Then

Set CurrentMenuList = CurrentMenuList.MenuItem(CurrentMenuList.CurrentPos).SubMenulist

CurrentMenuList.CurrentPos = 1

ShowMenuList

Else

CurrentMenuList.MenuItem(CurrentMenuList.CurrentPos).LinkForm.Show

End If

Case vbKeyEscape

If Not (CurrentMenuList.FatherMenuList Is Nothing) Then

Set CurrentMenuList = CurrentMenuList.FatherMenuList

CurrentMenuList.CurrentPos = CurrentMenuList.CurrentPos

ShowMenuList

End If

End Select

Me.ImgHand.Top = Me.LblItem(CurrentMenuList.CurrentPos).Top

End Sub

Private Sub ImgHand_Click()

End Sub

Private Sub LblItem_Click(Index As Integer)

If Index <= CurrentMenuList.MenuItemNumber Then

CurrentMenuList.CurrentPos = Index

Me.ImgHand.Top = Me.LblItem(CurrentMenuList.CurrentPos).Top

End If

End Sub

Private Sub LblTitle_Click()

End Sub

2006-05-29 13:19
xgwdtx511
Rank: 1
等 级:新手上路
帖 子:10
专家分:0
注 册:2006-5-29
收藏
得分:0 
功能模块5

Private Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long

Private Type RECT

Left As Long

Top As Long

Right As Long

Bottom As Long

End Type

Private Sub aaa_Click()

End Sub

Private Sub MDIForm_Resize()

'adjust form size which form in.

Dim ClientRect As RECT

GetClientRect Me.hwnd, ClientRect

FrmMenu.Move 0, 0, 15 * (ClientRect.Right - ClientRect.Left), 15 * (ClientRect.Bottom - ClientRect.Top)

FrmMenu.Visible = True

End Sub
功能模块6

Clsmenuitem

Public seq As Integer

Public caption As String

Public FormOrMenulist As Boolean

Public SubMenulist As ClsMenuList

Public LinkForm As Form

Private Sub Class_Initialize()

End Sub

功能模块7

Clsmenulist

Private mvarFatherMenuList As ClsMenuList '局部复制

Private mvarTitle As String '局部复制

Private mvarMenuItemNumber As Integer '局部复制

Private mvarMenuItem(1 To 10) As ClsMenuItem '局部复制

Private mvarCurrentPos As Integer '局部复制

Public Sub IniMenuList(vTitle As String, vFatherMenulist As ClsMenuList)

mvarTitle = vTitle

Set mvarFatherMenuList = vFatherMenulist

End Sub

Public Sub AddMenuItem(vCaption As String, vSeq As Integer, vLink As Variant)

mvarMenuItemNumber = mvarMenuItemNumber + 1

Set mvarMenuItem(mvarMenuItemNumber) = New ClsMenuItem

mvarMenuItem(mvarMenuItemNumber).caption = vCaption

mvarMenuItem(mvarMenuItemNumber).seq = mvarMenuItemNumber

If TypeOf vLink Is Form Then

mvarMenuItem(mvarMenuItemNumber).FormOrMenulist = False

Set mvarMenuItem(mvarMenuItemNumber).LinkForm = vLink

Else

mvarMenuItem(mvarMenuItemNumber).FormOrMenulist = True

Set mvarMenuItem(mvarMenuItemNumber).SubMenulist = vLink

End If

End Sub

Public Property Let CurrentPos(ByVal vData As Integer)

mvarCurrentPos = vData

End Property

Public Property Get CurrentPos() As Integer

CurrentPos = mvarCurrentPos

End Property

Public Property Get MenuItem(Index As Integer) As ClsMenuItem

Set MenuItem = mvarMenuItem(Index)

End Property

Public Property Get MenuItemNumber() As Integer

MenuItemNumber = mvarMenuItemNumber

End Property

Public Property Get Title() As String

Title = mvarTitle

End Property

Public Property Get FatherMenuList() As ClsMenuList

Set FatherMenuList = mvarFatherMenuList

End Property

Private Sub Class_Initialize()

mvarMenuItemNumber = 0

mvarCurrentPos = 1

End Sub

2006-05-29 13:20
xgwdtx511
Rank: 1
等 级:新手上路
帖 子:10
专家分:0
注 册:2006-5-29
收藏
得分:0 
功能模块8

ClsDrawLine

Const MINVIEWDAYWIDTH = 10

Const MAXVIEWDAYWIDTH = 160

Const STEPMINVIEWDAYWIDTH = 2

Const STEPMAXVIEWDAYWIDTH = 30

Public OneDayData As New ClsOneDayData

Public Enum EnumLineStyle

[day k line] = 1

[amount line]

[circle point line]

[link line ]

End Enum

Dim WithEvents Pic As PictureBox

Dim DayData() As TypeDayData

Dim TotalDayInFile As Long

Dim OneDayLineWidth As Integer

Dim WhiteLinePos As Long

Dim WhiteLineIndexInFile As Long

Private mvarLineStyle As EnumLineStyle

Private mvarStockFile As String

Private mvarViewDayWidth As Integer

Private mvarViewStartDayIndex As Long

Private mvarViewEndDayIndex As Integer

Event KeyDwn()

Public Property Let ViewEndDayIndex(ByVal vData As Integer)

mvarViewEndDayIndex = vData

End Property

Public Property Get ViewEndDayIndex() As Integer

ViewEndDayIndex = mvarViewEndDayIndex

End Property

Public Property Let ViewStartDayIndex(ByVal vData As Long)

mvarViewStartDayIndex = vData

End Property

Public Property Get ViewStartDayIndex() As Long

ViewStartDayIndex = mvarViewStartDayIndex

End Property

Public Property Let ViewDayWidth(ByVal vData As Integer)

mvarViewDayWidth = vData

End Property

Public Property Get ViewDayWidth() As Integer

ViewDayWidth = mvarViewDayWidth

End Property

Public Property Let LineStyle(ByVal vData As EnumLineStyle)

mvarLineStyle = vData

End Property

Public Property Get LineStyle() As EnumLineStyle

LineStyle = mvarLineStyle

End Property

Public Property Let StockFile(ByVal vData As String)

If vData = "" Then

Err.Raise 380

Exit Property

End If

mvarStockFile = vData

ReadDayData

ViewDayWidth = MINVIEWDAYWIDTH * 2

If TotalDayInFile > ViewDayWidth Then

ViewStartDayIndex = TotalDayInFile - ViewDayWidth + 1

ViewEndDayIndex = TotalDayInFile

Else

ViewEndDayIndex = TotalDayInFile

ViewStartDayIndex = 1

End If

WhiteLineIndexInFile = TotalDayInFile

SetOneDayData

End Property

Public Property Get StockFile() As String

StockFile = mvarStockFile

End Property

Public Sub SetPic(p As PictureBox)

Set Pic = p

End Sub

Private Sub ReadDayData()

Dim ii As Integer

ii = FreeFile

TotalDayInFile = FileLen(StockFile) \ Len(DayData(1))

ReDim DayData(TotalDayInFile) As TypeDayData

Open StockFile For Binary As #ii

For z = 1 To TotalDayInFile

Get ii, , DayData(z).this_date '日期

Get ii, , DayData(z).kp ' 开盘

Get ii, , DayData(z).hi '最高

Get ii, , DayData(z).lo '最低

Get ii, , DayData(z).sp '收盘

Get ii, , DayData(z).e ' 成交额

Get ii, , DayData(z).l '成交量

Get ii, , DayData(z).num1x

Get ii, , DayData(z).num2x

Get ii, , DayData(z).num3x

Next z

Close #ii

End Sub

2006-05-29 13:27
xgwdtx511
Rank: 1
等 级:新手上路
帖 子:10
专家分:0
注 册:2006-5-29
收藏
得分:0 
接上贴

Public Sub DrawLine()

Select Case LineStyle

Case 1

DrawKLineGraph

Case 2

DrawAMTLineGraph

' Case 3

' DrawCIRLineGraph

' Case 4

' DrawLINKLineGraph

End Select

End Sub

Private Sub DrawWhiteLine()

b = (WhiteLinePos - 0.5) * OneDayLineWidth

Pic.Line (b, Pic.ScaleTop)-(b, Pic.ScaleTop + Pic.ScaleHeight), RGB(255, 255, 255)

End Sub

Private Sub DrawKLineGraph()

Dim i As Long, xi As Long, da As Long

Pic.Cls

da = MaxHighInView

xi = MinHighInView

DrawFrameLine xi, da, 4

OneDayLineWidth = Pic.ScaleWidth / ViewDayWidth

For i = 0 To ViewEndDayIndex - ViewStartDayIndex

j = i + ViewStartDayIndex

DrawKLineUnit i, DayData(j).hi, DayData(j).lo, DayData(j).kp, DayData(j).sp

Next i

End Sub

Private Sub DrawAMTLineGraph()

Dim i As Long, xi As Long, da As Long

Pic.Cls

da = MaxAMTInView

xi = 0

DrawFrameLine xi, da, 4

OneDayLineWidth = Pic.ScaleWidth / ViewDayWidth

For i = 0 To ViewEndDayIndex - ViewStartDayIndex

j = i + ViewStartDayIndex

DrawAMTLineUnit i, DayData(j).l, DayData(j).kp, DayData(j).sp

Next i

End Sub

Private Sub DrawFrameLine(Min As Long, Max As Long, CutNum As Integer)

Pic.ScaleTop = Max

Pic.ScaleHeight = Min - Max

Pic.DrawStyle = 1 'dash

For i = 1 To CutNum - 1

h = Min - Pic.ScaleHeight / CutNum * i

Pic.Line (0, h)-(Pic.ScaleWidth, h), RGB(0, 255, 255)

Pic.CurrentX = 0

Pic.CurrentY = h

Pic.Print Int(h)

Next i

Pic.DrawStyle = 0 'solid

End Sub

Private Sub DrawKLineUnit(seq As Long, hi As Long, lo As Long, kp As Long, sp As Long)

a = (seq + 0.1) * OneDayLineWidth

c = (seq + 0.9) * OneDayLineWidth

b = (seq + 0.5) * OneDayLineWidth

If kp < sp Then

Pic.Line (a, sp)-(c, kp), RGB(255, 0, 0), B

Pic.Line (b, sp)-(b, hi), RGB(255, 0, 0)

Pic.Line (b, kp)-(b, lo), RGB(255, 0, 0)

Else

Pic.Line (a, kp)-(c, sp), RGB(0, 255, 0), B

Pic.Line (b, sp)-(b, lo), RGB(0, 255, 0)

Pic.Line (b, kp)-(b, hi), RGB(0, 255, 0)

End If

End Sub

Private Sub DrawAMTLineUnit(seq As Long, l As Long, kp As Long, sp As Long)

a = (seq + 0.1) * OneDayLineWidth

c = (seq + 0.9) * OneDayLineWidth

b = (seq + 0.5) * OneDayLineWidth

If sp < kp Then

Pic.Line (a, 0)-(c, l), RGB(0, 255, 0), B

Else

Pic.Line (a, 0)-(c, l), RGB(255, 0, 0), B

End If

End Sub

2006-05-29 13:28
xgwdtx511
Rank: 1
等 级:新手上路
帖 子:10
专家分:0
注 册:2006-5-29
收藏
得分:0 
接上贴

Private Function MaxHighInView() As Long

Dim cur_max As Long

cur_max = DayData(ViewStartDayIndex).hi

For i = ViewStartDayIndex + 1 To ViewEndDayIndex

If cur_max < DayData(i).hi Then cur_max = DayData(i).hi

Next i

MaxHighInView = cur_max

End Function

Private Function MinHighInView() As Long

Dim cur_min As Long

cur_min = DayData(ViewStartDayIndex).lo

For i = ViewStartDayIndex + 1 To ViewEndDayIndex

If cur_min > DayData(i).lo Then cur_min = DayData(i).lo

Next i

MinHighInView = cur_min

End Function

Private Function MaxAMTInView() As Long

Dim cur_max As Long

cur_max = DayData(ViewStartDayIndex).l

For i = ViewStartDayIndex + 1 To ViewEndDayIndex

If cur_max < DayData(i).l Then cur_max = DayData(i).l

Next i

MaxAMTInView = cur_max

End Function

Private Function MinAMTInView() As Long

Dim cur_min As Long

cur_min = DayData(ViewStartDayIndex).l

For i = ViewStartDayIndex + 1 To ViewEndDayIndex

If cur_min > DayData(i).l Then cur_min = DayData(i).l

Next i

MinAMTInView = cur_min

End Function

Private Sub Class_Initialize()

End Sub

Public Sub Pic_KeyDown(KeyCode As Integer, Shift As Integer)

'zoom out

If KeyCode = vbKeyDown And ViewDayWidth < MAXVIEWDAYWIDTH Then

ViewDayWidth = ViewDayWidth * 2

If ViewStartDayIndex >= ViewDayWidth \ 2 Then

ViewStartDayIndex = ViewStartDayIndex - ViewDayWidth \ 2

ElseIf TotalDayInFile >= ViewDayWidth Then

ViewStartDayIndex = 1

ViewEndDayIndex = ViewDayWidth

Else

ViewStartDayIndex = 1

ViewEndDayIndex = TotalDayInFile

End If

DrawLine

WhiteLinePos = 1

End If

'zoom in

If KeyCode = vbKeyUp And ViewDayWidth > MINVIEWDAYWIDTH Then

ViewDayWidth = ViewDayWidth \ 2

If ViewEndDayIndex - ViewStartDayIndex + 1 = ViewDayWidth * 2 Then 'full

ViewStartDayIndex = ViewStartDayIndex + ViewDayWidth

ElseIf TotalDayInFile >= ViewDayWidth Then

ViewEndDayIndex = TotalDayInFile

ViewStartDayIndex = TotalDayInFile - ViewDayWidth + 1

Else

ViewEndDayIndex = TotalDayInFile

ViewStartDayIndex = 1

End If

DrawLine

End If

'move left

If KeyCode = vbKeyLeft And Shift = vbCtrlMask Then

If ViewStartDayIndex > ViewDayWidth / 2 Then

ViewStartDayIndex = ViewStartDayIndex - ViewDayWidth / 2

Else

ViewStartDayIndex = 1

End If

If TotalDayInFile >= ViewStartDayIndex + ViewDayWidth Then

ViewEndDayIndex = ViewStartDayIndex + ViewDayWidth

Else

ViewEndDayIndex = TotalDayInFile

End If

DrawLine

End If

'move right

If KeyCode = vbKeyRight And Shift = vbCtrlMask Then

If ViewEndDayIndex <= TotalDayInFile - ViewDayWidth / 2 Then

ViewEndDayIndex = ViewEndDayIndex + ViewDayWidth / 2

Else

ViewEndDayIndex = TotalDayInFile

End If

If ViewEndDayIndex >= ViewDayWidth Then

ViewStartDayIndex = ViewEndDayIndex - ViewDayWidth + 1

Else

ViewStartDayIndex = 1

End If

DrawLine

End If

2006-05-29 13:29
xgwdtx511
Rank: 1
等 级:新手上路
帖 子:10
专家分:0
注 册:2006-5-29
收藏
得分:0 
接上贴

'white line left

If KeyCode = vbKeyLeft And Shift <> vbCtrlMask Then

If WhiteLinePos = 1 And ViewStartDayIndex > 1 Then

ViewStartDayIndex = ViewStartDayIndex - 1

ViewEndDayIndex = ViewEndDayIndex - 1

ElseIf WhiteLinePos = 0 Then

WhiteLinePos = IIf(ViewEndDayIndex - ViewStartDayIndex + 1 = ViewDayWidth, ViewDayWidth, ViewEndDayIndex - ViewStartDayIndex)

ElseIf WhiteLinePos > 1 Then

WhiteLinePos = WhiteLinePos - 1

End If

DrawLine

DrawWhiteLine

SetOneDayData

End If

'white line right

If KeyCode = vbKeyRight And Shift <> vbCtrlMask Then

If WhiteLinePos = ViewDayWidth And ViewEndDayIndex < TotalDayInFile Then

ViewStartDayIndex = ViewStartDayIndex + 1

ViewEndDayIndex = ViewEndDayIndex + 1

ElseIf WhiteLinePos = 0 Then

WhiteLinePos = 1

ElseIf WhiteLinePos < ViewDayWidth Then

WhiteLinePos = WhiteLinePos + 1

End If

DrawLine

DrawWhiteLine

SetOneDayData

End If

WhiteLineIndexInFile = ViewStartDayIndex + WhiteLinePos - 1

RaiseEvent KeyDwn

End Sub

Private Sub SetOneDayData()

OneDayData.TheDate = DayData(WhiteLineIndexInFile).this_date

OneDayData.hi = DayData(WhiteLineIndexInFile).hi

OneDayData.lo = DayData(WhiteLineIndexInFile).lo

OneDayData.sp = DayData(WhiteLineIndexInFile).sp

OneDayData.kp = DayData(WhiteLineIndexInFile).kp

OneDayData.num = DayData(WhiteLineIndexInFile).l

OneDayData.amt = DayData(WhiteLineIndexInFile).e

End Sub

Private Sub Pic_Resize()

DrawLine

End Sub

2006-05-29 13:30
快速回复:下了个程序看不明白,讲解功能,vb程序几个常用模块
数据加载中...
 
   



关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.017927 second(s), 7 queries.
Copyright©2004-2024, BCCN.NET, All Rights Reserved