VB ActiveX(1)

VB ActiveX 使用方法(一)

回首頁

分類	標題	大意	作者	日期
MSFLXGRD	在 MsFlexGrid 裏輸入資料	Col & Row	老怪	1998/7/15
MSFLXGRD	在 MsFlexGrid Sort		老怪	1998/8/13
MSFLXGRD	取出 MsFlexGrid 的值		老怪	1998/8/18
MSCHART	使用 MsChart 繪圖		老怪	1998/7/15
CRYSTL32	用 CrystalReport 印報表	RPT 檔在 VB 裏的運用	老怪	1998/7/16
MSWINSOCK	SendData 的時機	WinSock.State 屬性	老怪	1998/8/2
MSWINSOCK	傳送二進位資料		老怪	1998/9/6
ToolBar	在 MdiForm 裏啟動子表單	Button 物件的使用	老怪	1998/8/14
ToolBar	插入按紐圖示	搭配 ImageList 的運用	老怪	1998/11/26
MaskEdit	如何在 MaskEdit 裏輸入中文字元	遮罩字元 "C"	老怪	1998/8/14
RichTextBox	用程式敘述變換字體		老怪	1998/8/29
RichTextBox	HyPerLink 模擬		老怪	1998/8/30
RichTextBox	在RTF檔中搜尋某一個字串	RichTextBox.LoadFile	老怪	1998/9/22
ProgressBar	ProgressBar 基本運作模型		老怪	1998/9/15
SSTab	如何在 SSTab 中切換頁籤		老怪	1998/9/26
MCIControl	背景循環播放 Wave 檔		老怪	1998/10/14
TreeView	Node 物件的捲動		老怪	1998/12/9
TreeView	Nodes.Add 方法參數詳解		老怪	1998/12/9
自製元件	如何讓元件執行期不可見	UserControl.InvisibleAtRuntime	老怪	1998/8/12
自製元件	ActiveX 事件的產生	Event & RaiseEvent	老怪	1998/9/24

在 MsFlexGrid 裏輸入資料

星の金貨撰寫於文章

Microsoft FlexGrid Control 5.0 這個 Ocx 將他建立出來之後不知道要如何控制才能輸入資料

老怪答：

設定欄數及列數
- MSFlexGrid1.Cols = 10
- MSFlexGrid1.Rows = 10
- 指定列欄數各是十
指定作用中的 Celll：
- MSFlexGrid1.Col = 2
- MSFlexGrid1.Row = 3
- 指定某 cell(2,3) 為目前動作的 cell
設定目前動作 Cell 的文字：
- MSFlexGrid1.Text = "Do it"
載入圖片
- Set MSFlexGrid1.CellPicture = LoadPicture("c:\test\bow.ico")

使用 MsChart 繪圖

hahaha 撰寫於文章

叫了graph物件來畫數值圖，但不知如何將數值show出來，煩請各位前輩解答，謝謝！

老怪答：

請參考下例：

Dim varStyle(11) As Integer
Private Sub Command1_Click()
Static Style As Integer
    If Style > 11 Then Style = 0

    MSChart1.chartType = varStyle(Style)

    Style = Style + 1
End Sub

Private Sub Form_Load()
Dim MyData(4, 1) As Single
    varStyle(0) = VtChChartType2dArea
    varStyle(1) = VtChChartType2dBar
    varStyle(2) = VtChChartType2dCombination
    varStyle(3) = VtChChartType2dLine
    varStyle(4) = VtChChartType2dPie
    varStyle(5) = VtChChartType2dStep
    varStyle(6) = VtChChartType2dXY
    varStyle(7) = VtChChartType3dArea
    varStyle(8) = VtChChartType3dBar
    varStyle(9) = VtChChartType3dCombination
    varStyle(10) = VtChChartType3dLine
    varStyle(11) = VtChChartType3dStep

    MyData(0, 0) = 1
    MyData(0, 1) = 10
    MyData(1, 0) = 2
    MyData(1, 1) = 30
    MyData(2, 0) = 3
    MyData(2, 1) = 20
    MyData(3, 0) = 4
    MyData(3, 1) = 15
    MyData(4, 0) = 5
    MyData(4, 1) = 25

    MSChart1.ChartData = MyData

End Sub

回索引

用 CrystalReport 印報表

小高撰寫於文章

在vb中使用報表產生器作出了一個報表，要如何將這個列印功能加入我設計的程式中？

老怪答：

CrystalReport1.Destination = crptToPrinter
CrystalReport1.ReportFileName = "你的報表檔"
CrystalReport1.Action = 1

回索引

SendData 的時機

韋恩撰寫於文章

winsock1.state 有時等於 sckConnecting (6) 此時呼叫 winsock1.senddata 會錯誤，winsock1.dtate 有時等於 sckConnected (7) 此時呼叫 winsock1.senddata 成功不知是何原因?

老怪答：

WinSock.State=sckConnecting 表示正在連線，連的成連不成都還不知道，怎麼Senddata 呢？
WinSock.State=sckConnected 是完成式，表示連線成功了，當然就可以 SendData 了，所以在 SendData 之前，還是先 Check WinSock.State 狀態比較好。
你也可採這樣的敘述：
Private Sub Command1_Click()
Winsock1.Connect
End Sub

Private Sub Winsock1_Connect()
Winsock1.SendData "YourData"
End Sub
因為Winsock1_Connect()是 Connect 完成後產生的通知事件，在這裡 SendData ，可避免未連線完成即 SendData。

回索引

如何讓元件執行期不可見

兜仔撰寫於文章

請問我想取消一個自己做的control的height 和width 屬性應該怎樣做??就如timercontrol 一樣不能控制size,沒有 height 和width 屬性可選擇!!

老怪答：

UserControl.InvisibleAtRuntime=True

不過這就和 timer 一樣，執行時期不可見了，所以執行時期可見的 Control ，一定會有 left,top,width,height 的屬性。

回索引

在 MsFlexGrid Sort

彩虹汽水+可樂娜氣泡撰寫於文章

請問如何讓 MFSGric 中的資料照字母先後序排列?是不是有什麼屬性可以用來直接控制這個性質?

老怪答：

MSFlexGrid 有一個叫 Sort 的屬性，是執行階段才能使用的屬性，MSFlexGrid 附有完整的說明和範例，不論是在 Help 裏，或是瀏覽視窗裏，都可以叫的到，你去找找。範例如下：

Private Sub Command1_Click()
FG.Col = 0
FG.Sort = 7
End Sub

Private Sub Command2_Click()
FG.Col = 1
FG.Sort = 7
End Sub

Private Sub Command3_Click()
FG.Col = 2
FG.Sort = 7
End Sub

Private Sub Form_Load()
FG.Cols = 3
FG.AddItem "A" & Chr(9) & "04" & Chr(9) & "Z"
FG.AddItem "B" & Chr(9) & "08" & Chr(9) & "Y"
FG.AddItem "C" & Chr(9) & "02" & Chr(9) & "X"
FG.AddItem "D" & Chr(9) & "09" & Chr(9) & "W"
FG.AddItem "E" & Chr(9) & "03" & Chr(9) & "U"

Command1.Caption = "Sort 1"
Command2.Caption = "Sort 2"
Command3.Caption = "Sort 3"
End Sub

本例 MSFlexGrid.Name=FG

回索引

取出 MsFlexGrid 的值

Smith 撰寫於文章

當我把資料一一倒入MSFlexGrid中以後那我後來是否有辦法將其中一個欄位的資料再抓出來呢?

老怪答：

請你在 Form 上布置 Text1,Text2,MsflexGrid 後執行下列式子：

Option Explicit
Private Sub Form_Load()
Dim I As Integer

    MSFlexGrid1.Cols = 3
    MSFlexGrid1.Rows = 10
    '使用 TextArray 屬性，用資料來填滿 MSFlexGrid。
    For I = MSFlexGrid1.FixedRows To MSFlexGrid1.Rows - 1
        '** 資料行 1
        MSFlexGrid1.TextArray(faIndex(I, 1)) = I & "\ 1"
        '資料行 2.
        MSFlexGrid1.TextArray(faIndex(I, 2)) = I & "\ 2"
    Next
End Sub

Private Sub MSFlexGrid1_EnterCell()
Dim CellX As Long
Dim CellY As Long

    CellX = MSFlexGrid1.row
    CellY = MSFlexGrid1.col
    '利用 TextMatrix
    Text2.Text = MSFlexGrid1.TextMatrix(CellX, CellY)

    '利用指定 Cell
    MSFlexGrid1.col = CellY
    MSFlexGrid1.row = CellX
    Text1.Text = MSFlexGrid1.Text
End Sub

'計算跟 TextArray 屬性一起使用的索引。
Function faIndex(row As Integer, col As Integer) As Long
     faIndex = row * MSFlexGrid1.Cols + col
End Function

如果要用 Data 項，把 Form_Load 敘述拿掉即可

回索引

在 MdiForm 裏啟動子表單

小痣鳴撰寫於文章

請問一下在MDIForm中使用了ToolBar Control,那當在ToolBar上按下按鈕後,如何把控制權交給此時已經開啟的ChildForm呢?

老怪答：

Option Explicit

Dim Form2 As New Form1
Dim Form3 As New Form1

Private Sub MDIForm_Load()
Dim MyBS As Buttons
    Form2.Caption = "Form2"
    Form3.Caption = "Form3"

    Form2.Show
    Form3.Show

    Set MyBS = Toolbar1.Buttons
    MyBS.Add , "Form1", "啟動表一"
    MyBS.Add , "Form2", "啟動表二"
    MyBS.Add , "Form3", "啟動表三"
End Sub

Private Sub Toolbar1_ButtonClick(ByVal Button As ComctlLib.Button)
    Select Case Button.Key
        Case "Form1"
            Form1.SetFocus
        Case "Form2"
            Form2.SetFocus
        Case "Form3"
            Form3.SetFocus
    End Select
End Sub

回索引

如何在 MaskEdit 裏輸入中文字元

遮罩字元用 "C" 可以輸入中文，不過要注意的是它把中文算兩個字，所以如果只剩一個遮罩字元，輸入會有錯誤。

回索引

用程式敘述變換字體

莫明奇妙... 的文章中提到:

我想問的題，有沒有辦法不 Load 檔案，而直接在程式中，直接寫成... RichTextBox1.text = ... 這樣的格式，而在其中，可以自己變換字体。我試過，如果在中間改成粗体，整個內容都會變更...有沒有辦法讓其中一小段變動就好了呢?

老怪答：

Private Sub Command1_Click()
Dim CR As String
'記錄選取之起始位置
Dim PosStart() As Long
'記錄選取之長度
Dim FLength() As Long
    CR = Chr(10)
    RichTextBox1.SelLength = 0
    RichTextBox1.Text = "Hello!" & CR
    RichTextBox1.Text = RichTextBox1.Text & "Hello2!" & CR
    RichTextBox1.Text = RichTextBox1.Text & "不要理我!" & CR

    ReDim PosStart(0)
    ReDim FLength(0)
    PosStart(0) = 0
    FLength(0) = Len(RichTextBox1.Text)

    RichTextBox1.Text = RichTextBox1.Text & "不要理我!" & CR
    ReDim Preserve PosStart(1)
    ReDim Preserve FLength(1)
    PosStart(1) = FLength(0)
    FLength(1) = Len(RichTextBox1.Text) - FLength(0)

    RichTextBox1.Text = RichTextBox1.Text & "不要理我!" & CR
    RichTextBox1.SelStart = PosStart(0)
    RichTextBox1.SelLength = FLength(0)
    RichTextBox1.SelBold = True

    RichTextBox1.SelStart = PosStart(1)
    RichTextBox1.SelLength = FLength(1)
    RichTextBox1.SelItalic = True

    RichTextBox1.SelStart = 0
End Sub

回索引

HyPerLink 模擬

VERSION 5.00
Object = "{3B7C8863-D78F-101B-B9B5-04021C009402}#1.1#0"; "RICHTX32.OCX"
Begin VB.Form frmMarkUp
   Caption         =   "Hyper MarkUp 模擬範例"
   ClientHeight    =   3480
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   5670
   LinkTopic       =   "Form1"
   ScaleHeight     =   3480
   ScaleWidth      =   5670
   StartUpPosition =   3 '系統預設值
   Begin RichTextLib.RichTextBox RTBox
      Height          =   3015
      Left            =   240
      TabIndex        =   0
      Top             =   240
      Width           =   5175
      _ExtentX        =   9128
      _ExtentY        =   5318
      _Version        =   327680
      ScrollBars      =   3
      TextRTF         =   $"markup.frx":0000
   End
End
Attribute VB_Name = "frmMarkUp"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'本 Form 操作方式是在文字區塊按滑鼠鍵，
'若按一般字則無反應，若按藍色加底線字串，
'則會有相對應之訊息產生。
Private Type RichHyper
    開始位置 As Long
    結束位置 As Long
    連結字串 As String
End Type
'儲存標記位置及連結的陣列
Dim Mark() As RichHyper
Private Sub Form_Load()
Dim PutString As String
Dim I As Integer
    '本範例用了三個標籤
    ReDim Mark(2)

    RTBox.Text = "News Group:tw.bbs.comp.language 公告" + Chr(10)
    RTBox.Text = RTBox.Text + "希望本版版友在 Post 問題之前能先做好下列準備
工作：" + Chr(10)

    '設定標籤一
    RTBox.Text = RTBox.Text + "1."
    '設定標籤字串及位置
    PutString = "先查詢 VB Help"
    Mark(0).開始位置 = Len(RTBox.Text)
    Mark(0).結束位置 = Len(RTBox.Text) + Len(PutString)
    Mark(0).連結字串 = "VB Help 使用說明"
    RTBox.Text = RTBox.Text + PutString + Chr(10)

    '設定標籤二
    RTBox.Text = RTBox.Text + "2."
    PutString = "查閱 VB5 初級生老怪範例"
    Mark(1).開始位置 = Len(RTBox.Text)
    Mark(1).結束位置 = Len(RTBox.Text) + Len(PutString)
    Mark(1).連結字串 = "老怪範例下載辦法說明"
    RTBox.Text = RTBox.Text + PutString + Chr(10)

    '設定標籤三
    RTBox.Text = RTBox.Text + "3."
    PutString = "仔細想清楚 Post 文章主題"
    Mark(2).開始位置 = Len(RTBox.Text)
    Mark(2).結束位置 = Len(RTBox.Text) + Len(PutString)
    Mark(2).連結字串 = "Post 注意事項"
    RTBox.Text = RTBox.Text + PutString + Chr(10)

    '為各標籤上色加底線
    For I = 0 To 2
        RTBox.SelStart = Mark(I).開始位置
        RTBox.SelLength = Mark(I).結束位置 - Mark(I).開始位置
        RTBox.SelUnderline = True
        RTBox.SelColor = RGB(0, 0, 255)
    Next

    '將指標放回 RTBox 開頭，並兼有消除選取區塊之作用
    RTBox.SelStart = 0

End Sub
Private Sub RTBox_Click()
Dim I As Long, Pointer As Long, MarkNum As Long
    '用 Pointer 記住游標目前位置
    Pointer = RTBox.SelStart
    '把標籤編號先設為 -1
    MarkNum = -1

    For I = 0 To 2
        '利用 Pointer 判斷游標是否落在標籤位置內
        If Pointer < Mark(I).結束位置 And Pointer > Mark(I).開始位置 Then
            '取得標籤編號
            MarkNum = I
            Exit For
        End If
    Next

    'MarkNum=-1 表示沒選到標籤，<>-1 則依標籤編號取出連結
    If MarkNum <> -1 Then
        MsgBox "你選擇了閱讀 [" & Mark(MarkNum).連結字串 & "] 這篇文章"
    End If
End Sub
Private Sub RTBox_KeyDown(KeyCode As Integer, Shift As Integer)
    '防止 RTBox 被使用者按 Return 鍵拆成兩段
    If KeyCode = 13 Then
        KeyCode = 0
    End If
End Sub
Private Sub RTBox_KeyPress(KeyAscii As Integer)
    '禁止使用者的鍵盤輸入
    KeyAscii = 0
End Sub

回索引

傳送二進位資料

寄件者: Chung Chien-shun

請問 Winsock 如何用位元陣列傳送和接收

老怪答：

送二進位檔案：
Dim FileHandle As Integer
Dim SendBuff() As Byte
    FileHandle = FreeFile
    Open "YourFilePathAndName" For Binary As #FileHandle
    ReDim SendBuff(LOF(FileHandle) - 1)
    Get #FileHandle, , SendBuff
    Winsock1.SendData SendBuff
送二進位字串：
Dim SendBuff() As Byte
Dim SendString As String
    SendString = "利用 WinSock.SendData 二進位方式送字串"
    ReDim SendBuff(LenB(StrConv(SendString, vbFromUnicode)) - 1)
    SendBuff = SendString
    Winsock1.SendData SendBuff

回索引

ProgressBar 基本運作模型

ProgressBar 基本運作模型如下：

Option Explicit

Private Sub Command1_Click()
Dim I As Integer
Dim HowLong As Date
    For I = ProgressBar1.Min To ProgressBar1.Max
        HowLong = Now
        ProgressBar1.Value = I
        Do While Second(Now - HowLong) < 1
        Loop
    Next
    ProgressBar1.Value = 0
    MsgBox "查詢完成"
End Sub

Private Sub Form_Load()
    ProgressBar1.Max = 100
    ProgressBar1.Min = 0
End Sub

回索引

在RTF檔中搜尋某一個字串

Private Sub Command1_Click()
Dim Search As Long
    RichTextBox1.LoadFile "FilePath&Name.rtf"
    Search = RichTextBox1.Find("尋找字串")

    If Search > -1 Then
        MsgBox "找到了"
    Else
        MsgBox "沒找到"
    End If
End Sub

如果不希望 Richtextbox 顯現出來，可將其 Visible=False

回索引

ActiveX 事件的產生

寄件者: jojos

我在編寫自己的 ocx 時, 編釋出來後, 可是發現跟其它的 control 都差很多, 缺少了很多事件, 這個需要使用什麼才能夠增加我的 control 事件..就像 control_Click, control_MouseMove, 這類的東西...

老怪答：

你必須有 Event 宣告及 RaiseEvent 敘述，大抵方式如下：
Option Explicit
'事件宣告:
Event Click() 'MappingInfo=UserControl,UserControl,-1,Click
Event DblClick() 'MappingInfo=UserControl,UserControl,-1,DblClick
Event MouseMove(Button As Integer, Shift As Integer, X As Single, Y As
Single) 'MappingInfo=UserControl,UserControl,-1,MouseMove

Private Sub UserControl_Click()
'事件產生程序
    RaiseEvent Click
End Sub
Private Sub UserControl_DblClick()
    RaiseEvent DblClick
End Sub
Private Sub UserControl_MouseMove(Button As Integer, Shift As Integer, X As
Single, Y As Single)
    RaiseEvent MouseMove(Button, Shift, X, Y)
End Sub

你可以用 [增益集]->[ActiveX 控制項介面精靈]幫你自動產生這些事件的程式碼，如果沒有此精靈，請用[增益功能管理員]新增。

回索引

如何在 SSTab 中切換頁籤

寄件者: 肯定是妳

SSTab(Tabctl32.ocx)控制項想用其它事件，就自動切到我想的那一頁。

老怪答：

請使用 SSTab 的 Tab、Tabs及 TabCaption 屬性。
.Print SSTab.Tabs 印出 Tab 總數
SStab.Tab=0,1,2....n 設定某編號 Tab 為現用 Tab
Print SSTab.TabCaption(Index) 印出某邊號之 TabCaption
用 Caption 設 Tab
Dim Cap As String
Dim I as Integer

    Cap="TabName"
    For I=0 to SStab.Tabs-1
        If SStab.TabCaption(I)=Cap Then
            SStab.Tab=I
            Exit For
        End If
    Next

回索引

背景循環播放 Wave 檔

寄件者: Wei-Shin Huang

我有一個Wave檔，我可以用MCI物件>讀取出來，也可以播放此檔案。但是我想重覆播放此一檔案，只需下一次命令。請問一下，這該怎麼做？

老怪答：

試試底下這段 Code ，把 MMControl1.filename 設為長一點的背景音樂，MMControl2.filename 設為短的觸發音樂，然後按 CommandButton 試試。惟一的缺憾是觸發音樂時背景音樂會暫停，不暫停背景音樂觸發音樂又出不來，還沒找到怎樣才能有混音的效果，如果你找到了請不吝告知我。

Option Explicit
Private Sub Command1_Click()
    MMControl1.Command = "Stop"
    '重新啟始 MCI WaveAudio 週邊設備。
    MMControl2.Command = "Prev"
    MMControl2.Command = "Play"
End Sub
Private Sub Form_Load()
    '把 MMControl 藏起來以免影響遊戲畫面
    MMControl1.Visible = False
    MMControl1.Notify = False
    MMControl1.Wait = True
    MMControl1.Shareable = False
    MMControl1.DeviceType = "WaveAudio"
    MMControl1.filename = "C:\Win32App\Premiere\Samples\CIRCUS.WAV"

    MMControl2.Visible = False
    MMControl2.Notify = False
    MMControl2.Wait = True
    MMControl2.Shareable = False
    MMControl2.DeviceType = "WaveAudio"
    MMControl2.filename = "C:\Program
Files\Plus!\Pinball\Sounds\SOUND16.WAV"

    '開啟 MCI WaveAudio 週邊設備。
    MMControl1.Command = "Open"
    '播放 MCI WaveAudio 週邊設備。
    MMControl1.Command = "Play"

    MMControl2.Command = "Open"
End Sub
Private Sub Form_Unload(Cancel As Integer)
    '關閉 MCI WaveAudio 週邊設備。
    MMControl1.Command = "Close"
    MMControl2.Command = "Close"
End Sub

Private Sub MMControl1_Done(NotifyCode As Integer)
    '如果播放完畢
    If NotifyCode = mciNotifySuccessful Then
        MMControl1.Command = "Play"
        '重新啟始 MCI WaveAudio 週邊設備。
        MMControl1.Command = "Prev"
    End If
End Sub
Private Sub MMControl2_Done(NotifyCode As Integer)
    If NotifyCode = mciNotifySuccessful Then
        MMControl1.Command = "Play"
        MMControl2.Command = "Stop"
    End If
End Sub

回索引

插入按紐圖示

ToolBar 的按鈕圖示是由 Windows Common Control 5.0 同組另一個物件叫 ImageList 提供的，就如同 DBGrid 要 DataControl 做 DataSource 一樣，ToolBar 是要和 ImageList 配套使用的。
請同時布置 ImageList 和 ToolBar 兩個物件在 Form 上。
在 ImageList 圖像那頁上插入你會用到的圖示。
在 ToolBar 一般那頁裏，在影像庫裏選你的 ImageList ，然後到按鈕那頁插入按鈕，並在影像欄寫你要用 Imagelist 裏第幾號圖示。
你或許會問，那 TreeView 和 ListView 也是這樣用的嗎，是的，整個 Windows Common Control 就是以 Imagelist 做圖形庫。

回索引

Node 物件的捲動

寄件者: 盧明德

在treeview中，當Drag一個 NODE 到最底下的 Node 時，該如何讓Treeview捲動，讓更底下的 Node 上捲？

老怪答：

本範例示範如何在拖曳 Node 物件的過程中，如何使捲軸配合捲動，而能使 Node 從第一筆拖到最後一筆。
表面上這個工作不困難，Node 物件的 EnsureVisible 方法就能使視窗以外的 Node 物件捲到視窗裏來呈現，因此在我們取得 Treeview.DropHighlight 物件後，就能用 Treeview.Nodes.Item(Treeview.DropHighLight.Index+1 or -1).EnSureVisible 把下'一個 Node 物件捲到視窗裏來。
但我們不要忘了，Treeview 是個樹狀物件，具有階層性。除非我們 TreeView 只有一層，'並且我們在 Add Node 物件時沒有做向前插入的動作，否則 TreeView.Nodes(Index) 的 Index 次序和實際上 Node 物件出現在視窗中的次序是完全不一樣的，如本例，以下列表左邊是 TreeView Node 插入次序，右邊則是實際視窗中的階層次序：
'Parent1:1
'Parent2:10
'Child 1:2
'Child 2:9
'Child 3:11
'Child 4:12
'Child 5:3
'Child 6:4
'Child 7:5
'Child 8:6
'Child 9:7
'Child 10:8
也就是說用Treeview.Nodes.Item(Treeview.DropHighLight.Index+1 or -1)抓到的物件根本不是實際在視窗中的下一個 Node，麻煩的是 TreeView 並沒有實際可取得階層排列次序的屬性(也可能是我沒找到，希望知道的人能告訴我。)
所以我利用一遞迴程式，把 TreeView Node 的階層次序放在一數值陣列裏，如此就能透過陣列指標找出某一 Node 在階層中的前一個及後一個物件。
執行本範例請使用 Microsoft Windows Common Control 5.0 元件，並於表單上
布置
'TreeView1,ImageList1

Option Explicit
'Node 階層次序指標
Dim AddNo As Integer
'存放 Node 階層次序的數值陣列
Dim Serial() As Integer
'前一個 Node 的 Index 值
Dim OldRec As Integer
'宣告全域變數。
Dim indrag As Boolean '指示拖放動作的旗標變數。
Dim nodX As Object '正被拖曳的項目。

Private Sub Form_Load()
    '在 Imagelist 控制項中載入一個點陣圖。
    Dim imgX As ListImage
    Dim BitmapPath As String
    BitmapPath = "c:\icons\drives.ico"
    Set imgX = ImageList1.ListImages.Add(, , LoadPicture(BitmapPath))

    '初始化 TreeView 控制項，並建立多個節點。
    TreeView1.ImageList = ImageList1
    Dim nodX As Node    '建立樹狀。
    Set nodX = TreeView1.Nodes.Add(, , , "Parent1", 1)
    Set nodX = TreeView1.Nodes.Add(, , , "Parent2", 1)
    Set nodX = TreeView1.Nodes.Add(1, tvwChild, , "Child 1", 1)
    Set nodX = TreeView1.Nodes.Add(1, tvwChild, , "Child 2", 1)
    Set nodX = TreeView1.Nodes.Add(2, tvwChild, , "Child 3", 1)
    Set nodX = TreeView1.Nodes.Add(2, tvwChild, , "Child 4", 1)
    Set nodX = TreeView1.Nodes.Add(3, tvwChild, , "Child 5", 1)
    Set nodX = TreeView1.Nodes.Add(7, tvwChild, , "Child 6", 1)
    Set nodX = TreeView1.Nodes.Add(7, tvwChild, , "Child 7", 1)
    Set nodX = TreeView1.Nodes.Add(9, tvwChild, , "Child 8", 1)
    Set nodX = TreeView1.Nodes.Add(10, tvwChild, , "Child 9", 1)
    Set nodX = TreeView1.Nodes.Add(11, tvwChild, , "Child 10", 1)
    nodX.EnsureVisible '展開樹狀，以顯示全部節點。

    '設定與 TreeView1.Nodes 同數目的陣列，Nodes 的 Index 基底為 1，
    '故 Serial 也設基底為 1。
    ReDim Serial(1 To TreeView1.Nodes.Count)
    '執行展開 TreeView 並記錄階層次序的自訂遞迴函數
    ExpandTree nodX.Root
    '先將前一個 Node 的 Index 值設為根 Node 的 Index
    OldRec = nodX.Root.Index
End Sub

Private Sub TreeView1_MouseDown(Button As Integer, Shift As Integer, x As
Single, y As Single)
    Set nodX = TreeView1.SelectedItem '設定要拖曳的項目。
End Sub

Private Sub TreeView1_DragDrop(Source As Control, x As Single, y As Single)
    If TreeView1.DropHighlight Is Nothing Then
        Set TreeView1.DropHighlight = Nothing
        indrag = False
        Exit Sub
    Else
        If nodX = TreeView1.DropHighlight Then Exit Sub
        Cls
        Print nodX.Text & " dropped on " & TreeView1.DropHighlight.Text
        Set TreeView1.DropHighlight = Nothing
        indrag = False
    End If
End Sub

'此 DragOver 程序為本範例重點
Private Sub TreeView1_DragOver(Source As Control, x As Single, y As Single,
State As Integer)
    On Error GoTo IgnoreHighLightNotSet
    If indrag = True Then
        '設定 DropHighlight 為滑鼠座標。
        Set TreeView1.DropHighlight = TreeView1.HitTest(x, y)
        '執行用 Nodes.Index 找 Nodes 階層 Index 的自訂函數
        TreeView1.Nodes.Item(GotNodeSerial(TreeView1.DropHighlight.Index, _
                OldRec)).EnsureVisible
        '把前一個 Node 的 Index 值設為 DropHighlight 的 Index
        OldRec = TreeView1.DropHighlight.Index
    End If
IgnoreHighLightNotSet:

    Select Case Err.Number
        Case 0
        Case 91
            'Err.Number = 91 是沒有設定物件，也就是 HitTest(x,y) 的 x,y 座標
沒有
            '正確落在某 Node 上，而是落在空白區上。因為落在空白區則
HitTest(x,y)
            '抓到的 Node 是空的，因此其後的程式碼會產生錯誤，為了避免程式產
生錯誤
            '訊息，所以這裏加一個錯誤處理程序。
        Case Else
            MsgBox Err.Description, vbOKOnly, "錯誤代碼：" & Err.Source
    End Select
End Sub

Private Sub TreeView1_MouseMove(Button As Integer, Shift As Integer, x As
Single, y As Single)
    If Button = vbLeftButton Then '指示一個拖曳動作。
        indrag = True '設定旗標變數為 true。
        '使用CreateDragImage方法設定拖曳圖示。
        TreeView1.DragIcon = TreeView1.SelectedItem.CreateDragImage
        TreeView1.Drag vbBeginDrag '拖曳動作。
    End If
End Sub

'展開 TreeView 並記錄 Nodes 階層次序的自訂遞迴函數
'重點是 ExNode 參數一定要是 Nodes 的 Root Node 物件，
'否則程式會不正確
Private Sub ExpandTree(ByVal ExNode As Node)
'該階層最後一個 Node 物件
Dim LastNode As Node
'演算用的 Node 物件
Dim TempNode As Node

    Set LastNode = ExNode.LastSibling
    Set TempNode = ExNode
    AddNo = AddNo + 1
    '把階層次序值放入相對應 Nodes 的 Index 指標中，以便供以後程式的使用
    Serial(TempNode.Index) = AddNo
    '如果 Node 底下還有子 Node
    If TempNode.Children > 0 Then
        '呼叫遞迴處理
        ExpandTree TempNode.Child
    End If

    Do
        '如果 Node 已是該階層最後一個 Node 則結束 Loop
        If TempNode = LastNode Then
            Exit Do
        End If

        '指向同階層下一個 Node
        Set TempNode = TempNode.Next
        AddNo = AddNo + 1
        Serial(TempNode.Index) = AddNo
        If TempNode.Children > 0 Then
            ExpandTree TempNode.Child
        End If
    Loop
End Sub

'用 Nodes Index 尋找視窗階層中下一個 Node 的 Index 值
'NodeIndex 是 DropHighLight.Index 值
'OldIndex 是上一次 DropHighLight.Index 值
'用此二 Index 來判斷是向前或向後捲動
Private Function GotNodeSerial(ByVal NodeIndex As Integer, _
        ByVal OldIndex As Integer) As Integer
Dim I As Integer
'要 EnsureVisible Node 的階層次序值
Dim SerialNo As Integer
    '要注意是這裡比較的是相對應於 Nodes Index 指標的
    'Serial 陣列元素值(亦即 Nodes 的階層次序)，而不是直接用 Nodes Index 來比
    '用 Index 來比正如我開頭所言，是錯誤的。
    Select Case Serial(NodeIndex) - Serial(OldIndex)
        '新指標比舊指標大，表示向下捲
        Case Is > 0
            If Serial(NodeIndex) < UBound(Serial) Then
                SerialNo = Serial(NodeIndex) + 1
            Else
                SerialNo = Serial(NodeIndex)
            End If
        '新指標比舊指標小，表示向上捲
        Case Is < 0
            If Serial(NodeIndex) > 1 Then
                SerialNo = Serial(NodeIndex) - 1
            Else
                SerialNo = Serial(NodeIndex)
            End If
        '沒改變不代表不須處理，因為 SerialNo 初值是 0 ，而 Serial 陣列裏並沒
有
        '索引值是 0 的元素。
        Case Else
            SerialNo = Serial(NodeIndex)
    End Select

    '找找看在 Serial 陣列中，擺放 SerialNo 的是第幾個陣列元素，其指標即
    '等於 Nodes Index 值。
    For I = 1 To UBound(Serial)
        If Serial(I) = SerialNo Then
            GotNodeSerial = I
            Exit For
        End If
    Next
End Function

回索引

Nodes.Add 方法參數詳解

忠於自己忠於原味撰寫於文章

treeview物件在 form_load時怎麼樣寫才不會讓treeview裡沒有東西啊!!!

老怪答：

要用 Treeview.Nodes 集合物件的 Add 方法來加入。
語法：
Dim AddNode As Node
Set AddNode=TreeView.Nodes.Add(relative, relationship, key, text, image,selectedimage)
先要了解 TreeView 階層關係如何建立，就要明白 relationship 參數：
- tvwNext= 2 （預設）：
  下一個節點。此 Node 位於在relative 中所指名的節點之後。
  如:Set AddNode=TreeView.Nodes.Add(,,,"Node 1")
  "Node 1" 的 Index =1
  Set AddNode=TreeView.Nodes.Add(1,tvwNext ,,"Node 2")
  表示 "Node 2" 擺在 "Node 1"之後
- tvwFirst=0 最先的節點：
  此 Node 和在relative 中所指名的節點位於同一層，並位於其它所有同層節點之前。
  Set AddNode=TreeView.Nodes.Add(2,tvwFirst ,,"Node 3")
  表示 "Node 3" 在 "Node 1"、"Node 2" 之前，擺在此 Node 層的第一位。
- tvwLast=1 最後的節點：
  此 Node 和在relative 中所指名的節點位於同一層，並位於其它所有同層節點之後。任何新加入的節點都會加在最後加入的節點之後。
  Set AddNode=TreeView.Nodes.Add(1,tvwLast ,,"Node 4")
  "Node 4" 擺在 "Node 3"、"Node 1"、"Node 2" 節點之後
- tvwPrevious=3 前一個節點：
  此 Node 位於在relative 中所指名的節點之前。
  Set AddNode=TreeView.Nodes.Add(4,tvwPrevious ,,"Node 5")
  因為 "Node 5" 是在 "Node 4" 之前，"Node 2" 之後。
- tvwChild=4 子節點。此 Node 成為在 relative 中所指名節點的子節點。
  Set AddNode=TreeView.Nodes.Add(2,tvwChild ,,"Node 6")
  表 "Node 6" 為 "Node 2" 的子節點。
key 選擇性的。單一特定的字串，用來以 Item 方法檢索 Node。
當你用 Set AddNode = TreeView.Nodes.Add(,, "E", "Node 5") 設定
key="E" 時
你就可以用 Print Treeview.Nodes.Item("E").Text 來取得該 Node 的引用。
text 必需的。在 Node 中出現的字串。
如本例中的 "Node 1"、"Node 2"......
image 選擇性的。
當你要為 Node 加上圖示影像時，你必須使用 ImageList 控制項
如
Dim imgX As ListImage
Dim BitmapPath As String

    BitmapPath = "c:\icons\drives.ico"
    Set imgX = ImageList1.ListImages.Add(, , LoadPicture(BitmapPath))
    '用 ImageList1 做 TreeView1 的影像庫
    TreeView1.ImageList = ImageList1
    '然後你可以用
    Set AddNode = TreeView1.Nodes.Add(, , "B", "Node 1", 1)
    '為你的 Node 加上 Icon 影像，1 表示用 ImageList 裏的第一張圖
selectedimage 選擇性的。
當 Node 被選取時，所要顯示的圖示。
用
    BitmapPath = "c:\icons\fax.ico"
    Set imgX = ImageList1.ListImages.Add(, , LoadPicture(BitmapPath))
再加一張圖，然後
    Set AddNode = TreeView1.Nodes.Add(, , "B", "Node 1", 1, 2)
    '則當你在 Node 上 Click 一下後，會發覺該 Node 和其他 Node 會有不一樣的圖
示，2 表示使用 ImageList 第二張圖。
其他 Node and Nodes 操作方法請使用瀏覽物件功能取得相關說明。
全部程式碼如下(記得在 Form 上放 TreeView1、ImageList1)：
Option Explicit
Private Sub Form_Click()
    Cls
    Print TreeView1.Nodes.Item("E").Text
End Sub

Private Sub Form_Load()
Dim AddNode As Node
'在 Imagelist 控制項中載入一個點陣圖。
Dim imgX As ListImage
Dim BitmapPath As String

    BitmapPath = "c:\icons\drives.ico"
    Set imgX = ImageList1.ListImages.Add(, , LoadPicture(BitmapPath))
    BitmapPath = "c:\icons\fax.ico"
    Set imgX = ImageList1.ListImages.Add(, , LoadPicture(BitmapPath))
    '初始化 TreeView 控制項，並建立多個節點。
    TreeView1.ImageList = ImageList1
    Set AddNode = TreeView1.Nodes.Add(, , "B", "Node 1", 1, 2)
    Set AddNode = TreeView1.Nodes.Add(1, tvwNext, "C", "Node 2", 1, 2)
    Set AddNode = TreeView1.Nodes.Add(2, tvwFirst, "A", "Node 3", 1, 2)
    Set AddNode = TreeView1.Nodes.Add(1, tvwLast, "F", "Node 4", 1, 2)
    Set AddNode = TreeView1.Nodes.Add(4, tvwPrevious, "E", "Node 5", 1, 2)
    Set AddNode = TreeView1.Nodes.Add(2, tvwChild, "D", "Node 6", 1, 2)
End Sub

VB ActiveX 使用方法(一)

分類

標題

大意

作者

日期