VB5 範例(5)

VB5 初級生老怪範例(五)

回首頁

分類	標題	大意	作者	日期
數值處理	求取質數		老怪	1998/8/21
數值處理	簡易 VB 運算器		老怪	1998/8/29
數值處理	不重覆的亂數		老怪	1998/9/4
數值處理	用 And 值做 IF 條件判斷	限制運算與包含運算的區別	老怪	1998/9/4
變數運用	用 For Each...In... 做多 Control 的控制		老怪	1998/8/29
控制項處理	CommandButton 的 Color 屬性		老怪	1998/8/29
控制項處理	ListBox 的 Item Move & Disabled	模擬 VB 不提供的屬性和方法	老怪	1998/9/9
控制項處理	一個Frame兩組以上的 Option Buttons	又一個 VB 障眼法	Peter	1998/9/12
控制項處理	在 TextBox 裏輸入 Chr(vbKeyTab)	攔截 Tab 鍵	老怪	1998/9/1
控制項處理	拆解多行 TextBox		老怪	1998/9/1
控制項處理	TextBox 限輸入數字與小數點	在 Text_Change 裏的作法	老怪	1998/9/14
控制項處理	列出 Container 容器裏的物件	Container & Controls	老怪	1998/9/14
物件處理	如何取得目前windows的預設列表機值		老怪	1998/8/29
物件處理	分列中文、英文字型	你忘了 StdFont.Charset 嗎	老怪	1998/9/20
使用者界面	一鈕控多 Form 的界面設計	ActiveForm 屬性的使用	老怪	1998/8/30
使用者界面	再論 ActiveForm 屬性	Screen & MdiForm	老怪	1998/9/3
使用者界面	自動切換 TextBox 的輸入法	ImeMode 的使用	老怪	1998/9/1
使用者界面	調動 Form 的上下次序	SetFocus 方法	老怪	1998/9/3
使用者界面	如何處理比螢幕大的 Form	啟用 MDIForm	老怪	1998/9/14
檔案 I/O	簡易隨機檔編輯器	Random 檔案延伸利用	老怪	1998/9/4

VB5 初級生範例使用說明

本範例歡迎非營利性個人及組織轉載使用，營利之利用請先徵得本人之同意，來信註明使用方式及回覆地址。
本範例所有的程式碼範例，皆屬十分基本的 VB 語法，如果您是個 VB User ，歡迎直接引用或改寫使用在你的程式中，本人不主張著作權，因為，沒辦法查嘛。
如果你是個 VB 初學者，又有點窮窮(和老怪一樣)，趕快把本頁另存新檔到你自己的磁碟，離線後慢慢看，也可以 Copy 給朋友喔(不可以收錢)。
本範例都是老怪幾個月來在 tw.bbs.comp.language 討論群組中回答版友問題的合輯，因為是針對問題解決，所有並沒有全面觀念的解說，不適合作為入門文章，但如果你讀了入門書，或是上了老師的課，心中仍不甚明白的話，就可以來這找找有沒有你要的答案，因為這都是別人問過的問題。

求取質數

Option Explicit

Private Function 求質數(ByVal CalcNum As Long) As Variant
Dim I As Long, J As Long
Dim varRedimNum As Long
Dim 整除數 As Boolean
Dim varReturn() As Long
    If CalcNum < 1 Then
        MsgBox "輸入數值不能小於 1 ", vbOKOnly, "參數錯誤"
        Exit Function
    End If

    '先把 1 裝進傳回陣列裏
    ReDim varReturn(varRedimNum)
    varReturn(varRedimNum) = 1

    '傳入值是 1 就不往下算
    If CalcNum = 1 Then
        求質數 = varReturn
        Exit Function
    End If

    '回傳陣列指標加 1
    varRedimNum = varRedimNum + 1

    For I = 2 To CalcNum
        For J = 2 To I
            If J <> I Then
                If (I Mod J) = 0 Then
                    整除數 = True
                    Exit For
                End If
            End If
        Next

        If Not 整除數 Then
            ReDim Preserve varReturn(varRedimNum)
            varReturn(varRedimNum) = I
            varRedimNum = varRedimNum + 1
        Else
            整除數 = False
        End If
    Next

    求質數 = varReturn

End Function

'求質數函數呼叫方法
Private Sub Command1_Click()
Dim Accept
Dim I As Long
    '傳入參數 1000
    Accept = 求質數(1000)

    '輸入值錯誤則結束
    If IsEmpty(Accept) Then Exit Sub

    '在 ListBox 上顯示結果
    For I = 0 To UBound(Accept)
        List1.AddItem Accept(I)
    Next
End Sub

用 For Each...In... 做多 Control 的控制

放一顆心... 撰寫於文章

如果很多個control要如何去控制呢??例如有20個checkbox,不希望取名從1到20...可以用array的方式嗎??

老怪答：

Option Explicit
Private Sub Command1_Click()
Dim Cont As Control
    For Each Cont In Me.Controls
        If TypeName(Cont) = "CheckBox" Then
            Cont.Visible = Not Cont.Visible
        End If
    Next
End Sub

CommandButton 的 Color 屬性

在 VB 5 裏 CommandButton 的各 Color 屬性是和其他控制項很不一樣的。
CommandButton 沒有 ForeColor 屬性，也就是說它的 Caption 永遠只有一個顏色，就是 Windows 系統定義的 [按鈕上面文字的顏色]。
CommandButton.BackColor 設定，只有當 CommandButton.Style=1( 圖片外觀)時才能呈現出來，如果 Style=0(標準外觀)，CommandButton.BackColor 永遠是 Windows 系統定義的 [按鈕表面的顏色]。
CommandButton.MaskColor 可以指定 CommandButton.Picture 裏，某一色值區域是透明的(呈現 Command.BackColor 色彩)，不過先決條件是 CommandButton.UseMaskColor=True。

回索引

簡易 VB 運算器

丹（BOY）撰寫於文章

如何讓使用者在文字方塊輸入任意數值及數學運算式後，由 VB 加以運算？

老怪答：

Option Explicit
'FUnit 第一運算元，
'CalcUnit 運算子，
'LUnit 第二運算元，
'執行此程式請於表單布置 4 個 TextBox 及 1 個 Command
'Text1->FUnit
'Text2->CalcUnit
'Text3->LUnit
'Text4->計算結果輸出
Private Function Operator(ByVal FUnit As Variant, _
        ByVal CalcUnit As String, ByVal LUnit As Variant) As Variant
Dim ReValue As Variant

    Select Case UCase(CalcUnit)
        '以下算術運算子運算
        Case "^"
            ReValue = FUnit ^ LUnit
        Case "*"
            ReValue = FUnit * LUnit
        Case "/"
            ReValue = FUnit / LUnit
        Case "\"
            ReValue = FUnit \ LUnit
        Case "MOD"
            ReValue = FUnit Mod LUnit
        Case "+"
            ReValue = FUnit + LUnit
        Case "-"
            ReValue = FUnit - LUnit

        '以下比較運算子
        Case "LIKE"
            ReValue = FUnit Like LUnit

        '以下連結運算子
        Case "&"
            ReValue = FUnit & LUnit

        '以下邏輯運算子
        Case "AND"
            ReValue = FUnit And LUnit
        Case "EQV"
            ReValue = FUnit Eqv LUnit
        Case "IMP"
            ReValue = FUnit Imp LUnit
        Case "NOT"
            ReValue = Not LUnit
        Case "OR"
            ReValue = FUnit Or LUnit
        Case "XOR"
            ReValue = FUnit Xor LUnit

        '無效運算子處理
        Case Else
            MsgBox "[" & CalcUnit & "] 不是一個有效的運算子", vbOKOnly _
                    , "輸入算式錯誤"
            Exit Function
    End Select

    Operator = ReValue
End Function

Private Sub Command1_Click()
    Text4.Text = Operator(Text1.Text, Text2.Text, Text3.Text)
End Sub

回索引

如何取得目前windows 的預設列表機值

Annie Chiu 撰寫於文章 ...

應如何取得目前windows 的預設列表機值
若該值在執行中會被更換, 請問又應如何將預設列表機還原成原來的

老怪答：

Option Explicit

'儲存印表機裝置名稱之變數
Dim DriveString As String

Private Sub Form_Click()
Dim X As Printer

    Print Printer.DeviceName
    Print Printer.DriverName

    For Each X In Printers
        '把印表機設定給與預設印表機不同名的其他印表機
        If X.DriverName <> DriveString Then
            Set Printer = X
            Exit For
        End If
    Next

    Print Printer.DeviceName
    Print Printer.DriverName

    For Each X In Printers
        '檢查 DriveString 的值，把預設印表機抓回來
        If X.DriverName = DriveString Then
            Set Printer = X
            Exit For
        End If
    Next

    Print Printer.DeviceName
    Print Printer.DriverName

End Sub

Private Sub Form_Load()
    '把預設印表機的裝置名稱放到變數裏
    DriveString = Printer.DriverName
End Sub

回索引

一鈕控多 Form 的界面設計

hsu shihchieh 撰寫於文章

如果我想設計一排按鈕,及多張 Form ，如何讓 VB 知道我開那個 Form 並在 MainForm 中操縱 SubForm 裏的動作？

老怪答：

你在 MDIForm 上放一個 PictureBox，做為 CommandButton 的 Container。

在 Picturebox 上放三個 CommandButton.

加入 Form1.MdiChild=true

把 MDIForm 設為啟動表單，並把下列敘述貼到 MDIForm

Option Explicit

Private Sub Command1_Click()
    Me.ActiveForm.Print "ABC"
End Sub

Private Sub Command2_Click()
    Me.ActiveForm.Print "123"
End Sub

Private Sub Command3_Click()
    Me.ActiveForm.Print "好簡單"
End Sub

Private Sub MDIForm_Load()
Dim AForm As New Form1
Dim BForm As New Form1
Dim CForm As New Form1
    AForm.Show
    AForm.Caption = "AForm"
    BForm.Show
    BForm.Caption = "BForm"
    CForm.Show
    CForm.Caption = "CForm"
End Sub

啟動後輪流點 A,B,CForm ，再按 Command ，你就會看到效果。

回索引

在 TextBox 裏輸入 Chr(vbKeyTab)

bigcake 撰寫於文章

在一個 Form 中加入兩個 (或以上) 的 TextBox,在 Text1_KeyDown 抓不到 TAB 鍵 (vbKeyTab)why?又要如何解決呢?

老怪答：

你是要在 TextBox 裏用 Tab 輸定位符號嗎？麻煩的是 Tab 這個鍵訊號攔不住，似乎VB 一收到 Tab 就會把 Focus 交給下個控制項，而不會執行 KeyDown 裏面的程式敘述，你有兩個解決辦法：
把所有控制項的 TabStop 屬性設為 False(這等於使 Tab 鍵失能，會使使用者適應不良。)
用組合鍵 [Ctrl]+[Tab]如：
Private Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyTab And Shift = 2 Then
        Text1.SelText = Chr(vbKeyTab)
    End If
End Sub
再在你程式 Help 中向使用者說明，輸入 [Tab] 符號的方式是 [Ctrl]+[Tab]。

回索引

自動切換 TextBox 的輸入法

Private Sub Text1_GotFocus()
Text1.IMEMode = 1
End Sub
Private Sub Text1_LostFocus()
Text1.IMEMode = 2
End Sub

CWW5 來函意見：

ImeMode似乎有Bug，如果有多個TextBox設了ImeMode那會有一些意想不到的亂。

老怪意見：

多謝 CWW5 ，經測試的確有此現象，而且 Text1_LostFocus() 事件中的 Text1.IMEMode = 2 敘述好像也不正確，原因大概在 Mouse_Click 和 IMEMode Change 訊息傳送上有些問題。所以 Text.IMEMode 好像在事件處理上有那麼些奇怪的感覺。保險的作法是只使用一個 TextBox ，並由外部物件程序來變更 Text.IMEMode 屬性。例如我們在用 Access 97 時，在某些輸入欄位會自動切換輸入狀態，我想 VB 可以這麼模擬：

Private Sub MSFlexGrid1_Click()
Text1.IMEMode = 2
With MSFlexGrid1
Text1.Move .CellLeft + .Left, .CellTop + .Top, .CellWidth, .CellHeight
Text1.Text = .Text
'由 Col 屬性判斷第幾個欄位切換輸入狀態。
If .Col = 2 Then
Text1.IMEMode = 1
End If
Text1.SetFocus
End With
End Sub

回索引

拆解多行 TextBox

木頭撰寫於文章

如何將多行TextBox轉換成ListBox

老怪答：

本題解法重點在 TextBox 裏的斷行，必須由 Chr(13)+Chr(10) 兩字組合起來執行，所以應以 Chr(13) 為切割判斷點：

Dim AllString As String
Dim SingleString As String
Dim SepString As String
Dim I As Long
    AllString = Text1.Text

    For I = 1 To Len(AllString)
        SingleString = Mid(AllString, I, 1)
        If SingleString = Chr(13) Then
            '遇到 Chr(13) 則把分割字串加到 ListBox 裏
            List1.AddItem SepString
            SepString = ""
        Else
            If SingleString <> Chr(10) Then
                '除 Chr(10) 外逐字加入 SepString 中
                SepString = SepString + SingleString
            End If
        End If
    Next
    '加入最後一個 SepString
    List1.AddItem SepString

CWW5 來函意見：

拆解多行 TextBox 這限制在MultiLine而且有Keyin Enter來換行的TextBox，如果MultiLine之下一直KeyIn不換行，到了TextBox最右邊後，再Keyin的字會折下來，變成另一行，這方式解決不了，請查一下htmapi101.htm的做法。

老怪意見：

謝謝 CWW5 ，的確是如此，如果想分解 Mutiline 自動折回的字串，請到
http://sunh.hosp.ncku.edu.tw/~cww/htmapi101.htm 參考 CWW5 的做法。

回索引

再論 ActiveForm 屬性

寄件者: kook

我看了你的 Email後加入 Me.ActiveForm.PrintForm ,當我呼叫 Form2 ,and click the print botton(in Form1) , 結果出現錯誤.我想是VB不知誰是ActiveForm,
your's form1 是作何用??? 解釋一下, form1 及 MDIForm 是利用 MDIForm 做 mainform 還是用form1,

老怪答：

ActiveForm 是 Screen 及 MDIForm 才有的屬性，Form 物件是沒這作用的。
VB 裏只有 Start Form 的觀念，沒有 MainForm 的觀念，對於 ActiveForm 這屬性來說，Form.MDIChild=True 的 Form 要用 MDIForm.ActiveForm 來存取，Form.MdiChild=False 的 Form ，則用 Screen.ActiveForm 來存取。

回索引

調動 Form 的上下次序

段譽撰寫於文章

我現在有三個form (都不是全螢幕), 假設為A,B,C...A 在最下面, B 在中間, C 在最上面..控制權現在在 A上面
- 老怪答：這不太可能發生，如 AForm 有控制權，AForm 一定在最上面
請問要怎麼樣才能在 A form上把B form 調到C form 上面,
- 老怪答：BForm.SetFocus
或者是把B form 放到A 下面呢??
- 老怪答：AForm.SetFocus

回索引

不重覆的亂數

老怪：

其實本範例的原理和初級生範例第一輯，如何把牌洗散洗亂是同樣的，只是那範例夾雜花色判斷，再利用性較差，所以我改寫一下，把它做成 Function ，可以很方便的由你決定的開始數與結尾數中間的數值亂數重排後，以陣列形態送回。測試本範例請於 Form 上布置 Command1,List1。

Option Explicit
Private Function NoDoubleRnd(ByVal StartNum As Long, _
        ByVal EndNum As Long) As Variant
Dim ReturnArray() As Long
Dim TempNum As Long, I As Long, J As Long

    '如果起點數大於終點數則兩數對換
    If StartNum > EndNum Then
        TempNum = EndNum
        EndNum = StartNum
        StartNum = TempNum
    End If

    '依數值大小設定傳回 Array 大小
    ReDim ReturnArray(Abs(EndNum - StartNum))
    '把中間數裝進去
    For I = 0 To UBound(ReturnArray)
        ReturnArray(I) = StartNum + I
    Next

    '啟動亂數種子
    Randomize

    '利用 Rnd 重排陣列
    For I = UBound(ReturnArray) To 0 Step -1
        '隨指標縮減參與 Rnd 的陣列元素
        J = Int((I + 1) * Rnd)
        '把隨機指到的元素值放到 Buff
        '以利循序元素值及隨機元素值交換
        TempNum = ReturnArray(J)
        ReturnArray(J) = ReturnArray(I)
        ReturnArray(I) = TempNum
    Next
    '傳回經 Rnd 重排的陣列
    NoDoubleRnd = ReturnArray
End Function

Private Sub Command1_Click()
Dim Accept, I As Long

    '清除顯示的 ListBox
    List1.Clear

    '呼叫 NoDoubleRnd 自訂函數並接收傳回值
    Accept = NoDoubleRnd(0, 8)

    For I = 0 To UBound(Accept)
        List1.AddItem Accept(I)
    Next
End Sub

回索引

簡易隨機檔編輯器

本程式範例示範了以下一些方法：

以使用者自訂型態變數開啟 Random。
如何取得記錄總筆數。
如何為記錄加上刪除記號。
如何製作記錄指標器。
如何移除打上刪除記號的記錄。

VERSION 5.00
Begin VB.Form frmRandom
   Caption         =   "簡易隨機檔編輯器"
   ClientHeight    =   4170
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   5445
   LinkTopic       =   "Form1"
   ScaleHeight     =   4170
   ScaleWidth      =   5445
   StartUpPosition =   3 '系統預設值
   Begin VB.CommandButton btnClearData
      Caption         =   "清除刪除記錄"
      Height          =   495
      Left            =   2880
      TabIndex        =   13
      Top             =   3480
      Width           =   2175
   End
   Begin VB.CommandButton btnDelete
      Caption         =   "刪除"
      Height          =   495
      Left            =   2880
      TabIndex        =   12
      Top             =   2760
      Width           =   2175
   End
   Begin VB.CommandButton btnAdd
      Caption         =   "新增"
      Height          =   495
      Left            =   2880
      TabIndex        =   11
      Top             =   2040
      Width           =   2175
   End
   Begin VB.CommandButton btnEdit
      Caption         =   "更新"
      Height          =   495
      Left            =   2880
      TabIndex        =   10
      Top             =   1320
      Width           =   2175
   End
   Begin VB.CommandButton btnDown
      Caption         =   "下一筆"
      Height          =   495
      Left            =   4080
      TabIndex        =   9
      Top             =   600
      Width           =   855
   End
   Begin VB.CommandButton btnUp
      Caption         =   "上一筆"
      Height          =   495
      Left            =   2880
      TabIndex        =   8
      Top             =   600
      Width           =   975
   End
   Begin VB.TextBox txtSalary
      Height          =   375
      Left            =   240
      TabIndex        =   6
      Top             =   3360
      Width           =   1695
   End
   Begin VB.TextBox txtName
      Height          =   375
      Left            =   240
      TabIndex        =   4
      Top             =   2280
      Width           =   1695
   End
   Begin VB.TextBox txtNo
      Height          =   375
      Left            =   240
      TabIndex        =   2
      Top             =   1200
      Width           =   1695
   End
   Begin VB.Label Label5
      Caption         =   "員工薪資"
      Height          =   255
      Left            =   240
      TabIndex        =   7
      Top             =   2880
      Width           =   1695
   End
   Begin VB.Label Label4
      Caption         =   "員工姓名"
      Height          =   255
      Left            =   240
      TabIndex        =   5
      Top             =   1800
      Width           =   1695
   End
   Begin VB.Label Label3
      Caption         =   "員工編號"
      Height          =   255
      Left            =   240
      TabIndex        =   3
      Top             =   720
      Width           =   1695
   End
   Begin VB.Label Label2
      Caption         =   "Label2"
      Height          =   255
      Left            =   1680
      TabIndex        =   1
      Top             =   120
      Width           =   1575
   End
   Begin VB.Label Label1
      Caption         =   "檔案記錄"
      Height          =   255
      Left            =   240
      TabIndex        =   0
      Top             =   120
      Width           =   1215
   End
End
Attribute VB_Name = "frmRandom"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Type MyType
    '刪除記錄欄位
    Del As Boolean
    No As Long
    Name As String * 8
    Salary As Single
End Type
'開檔編號
Dim FileHandle As Integer
'存取欄位資料自訂變數
Dim MyMan As MyType
'實際的總記錄數
Dim RealNo As Long
'總記錄數
Dim FileLength As Long
'現在記錄編號
Dim RecNo As Long
'指標陣列
Dim Pointer() As Long
'刪除指標
Dim IsDelete As Boolean
Private Sub btnAdd_Click()
    If Not (IsNumeric(txtNo.Text) And IsNumeric(txtSalary.Text)) Then
        MsgBox "輸入資料錯誤"
        If RecNo <> 0 Then
            DataShow
        End If
        GoTo ReEnabled
    End If

    '現記錄加 1
    RecNo = FileLength + 1
    '實際記錄加 1
    RealNo = RealNo + 1
    '記錄陣列加 1
    ReDim Preserve Pointer(FileLength)
    '將實際紀錄值加到新元素裏
    Pointer(FileLength) = RealNo
    '總記錄也加 1
    FileLength = RecNo
    DataSave
    DataShow

ReEnabled:
    If FileLength = 0 Then
        NoRecord
    Else
        btnDown.Enabled = False
        If RecNo > 1 Then
            btnUp.Enabled = True
        End If
    End If

    txtNo.SetFocus
End Sub
Private Sub btnClearData_Click()
Dim TempHandle As Integer, I As Long
Dim TempMan As MyType

    '開暫存檔
    TempHandle = FreeFile
    Open "c:\temp\test.tmp" For Random As #TempHandle Len = Len(TempMan)

    '無記錄則跳至錯誤處理程序
    On Error GoTo ArrayInDexWrong
    '將資料檔未刪除記錄寫入暫存檔
    For I = 0 To UBound(Pointer)
        Get #FileHandle, Pointer(I), MyMan
        TempMan.Del = False
        TempMan.No = MyMan.No
        TempMan.Name = MyMan.Name
        TempMan.Salary = MyMan.Salary

        Put #TempHandle, I + 1, TempMan
    Next

ArrayInDexWrong:

    '關閉資料檔及暫存檔
    Close #TempHandle
    Close #FileHandle

    '用暫存檔覆蓋資料檔
    FileCopy "c:\temp\test.tmp", "c:\temp\test.txt"
    '刪除暫存檔
    Kill "c:\temp\test.tmp"

    '刪除指標陣列
    Erase Pointer
    '重新載入資料
    LoadData
End Sub
Private Sub btnDelete_Click()
Dim I As Long

    '設刪除指標為真
    IsDelete = True
    DataSave

    '重排指標陣列
    If FileLength = 1 Then
        Erase Pointer
    Else
        For I = RecNo To FileLength
            If I <> FileLength Then
                Pointer(I - 1) = Pointer(I)
            End If
        Next
        ReDim Preserve Pointer(FileLength - 2)
    End If

    RecNo = RecNo - 1
    FileLength = FileLength - 1

    If FileLength = 0 Then
        NoRecord
        TextClear
        ShowRec
    Else
        If RecNo = 0 Then RecNo = FileLength
        DataShow
    End If

    txtNo.SetFocus
End Sub
Private Sub btnDown_Click()
    RecNo = RecNo + 1
    DataShow
    txtNo.SetFocus
End Sub
Private Sub btnEdit_Click()
    DataSave
    txtNo.SetFocus
End Sub
Private Sub btnUp_Click()
    RecNo = RecNo - 1
    DataShow
    txtNo.SetFocus
End Sub
Private Sub Form_Load()
    LoadData
End Sub
Private Sub Form_Unload(Cancel As Integer)
    Close #FileHandle
End Sub
Private Sub DataShow()
    '讀入指標陣列資料
    Get #FileHandle, Pointer(RecNo - 1), MyMan
    txtNo.Text = MyMan.No
    txtName.Text = MyMan.Name
    txtSalary.Text = MyMan.Salary

    If RecNo <> 1 Then
        btnUp.Enabled = True
    Else
        btnUp.Enabled = False
    End If

    If RecNo <> FileLength Then
        btnDown.Enabled = True
    Else
        btnDown.Enabled = False
    End If
    ShowRec
    OpenEdit
End Sub
Private Sub DataSave()
    '依刪除指標決定 Del 欄值
    MyMan.Del = IsDelete
    MyMan.No = CLng(txtNo.Text)
    MyMan.Name = txtName.Text
    MyMan.Salary = CSng(txtSalary.Text)

    Put #FileHandle, Pointer(RecNo - 1), MyMan

    '將刪除指標復元
    IsDelete = False
End Sub
Private Sub ShowRec()
    Label2.Caption = RecNo & "/" & FileLength
End Sub

Private Sub LoadData()
Dim I As Long, J As Long
    FileHandle = FreeFile
    Open "c:\temp\test.txt" For Random As #FileHandle Len = Len(MyMan)
    '記算實際總記錄數
    RealNo = LOF(FileHandle) / Len(MyMan)
    If RealNo <> 0 Then
        For I = 1 To RealNo
            Get #FileHandle, I, MyMan
            '只把未刪除記錄放入指標陣列裏
            If Not MyMan.Del Then
                ReDim Preserve Pointer(J)
                Pointer(J) = I
                J = J + 1
            End If
        Next
    End If

    '未刪除記錄總數等於指標陣列數
    FileLength = J

    If FileLength = 0 Then
        ShowRec
        NoRecord
    Else
        RecNo = 1
        DataShow
    End If

End Sub
Private Sub NoRecord()
    btnUp.Enabled = False
    btnDown.Enabled = False
    btnEdit.Enabled = False
    btnDelete.Enabled = False
    btnClearData.Enabled = False
End Sub
Private Sub OpenEdit()
    btnEdit.Enabled = True
    btnDelete.Enabled = True
    btnClearData.Enabled = True
End Sub
Private Sub TextClear()
    txtNo.Text = ""
    txtName.Text = ""
    txtSalary.Text = ""
End Sub

回索引

ListBox 的 Item Move & Disabled

寄件者: Jessie

ListBox裡有一些選項,然後我想點選一個選項,往上或下拖曳, 還有如果我想讓 Listbox裡的其中一個選項Disable,可以看得到那個選項,但無法點選那個選項,而且也可以改變它的顏色,又要如何設定呢?

老怪答：

List 項目既經 AddItem 後位置即告確定，要改變只有重排。
ListBox Item 無 Disable 屬性，但每個 Item 都有一個附屬屬性叫ItemData(ItemData 不會顯示在 ListBox 裏)，這是一個長整數的資料型態，我們可以利用它做它做 Diabled 指標，譬如說 ItemData =-1 表 Disable。
ListBox 的 Item 無法單獨設定顏色，配合前面 ItemData 設定，你可以另外安排一Label 顯示非核取狀態。
以下即為一個替代方案：
Option Explicit
'執行本程式請在 Form 上布置 List1,Command1,Command2
'及 Label1
Dim MousePick As Long

Private Sub Command1_Click()
    If List1.ListIndex > -1 Then
        List1.ItemData(List1.ListIndex) = -1
    End If
End Sub

Private Sub Command2_Click()
    If List1.ListIndex > -1 Then
        List1.ItemData(List1.ListIndex) = 0
    End If
    Label1.Caption = ""
End Sub

Private Sub Form_Load()
    List1.AddItem "aaa"
    List1.ItemData(List1.NewIndex) = 0
    List1.AddItem "bbb"
    List1.ItemData(List1.NewIndex) = 0
    List1.AddItem "ccc"
    List1.ItemData(List1.NewIndex) = 0
    List1.AddItem "DDD"
    List1.ItemData(List1.NewIndex) = 0
    List1.AddItem "EEE"
    List1.ItemData(List1.NewIndex) = 0
    List1.AddItem "fff"
    List1.ItemData(List1.NewIndex) = 0
    List1.AddItem "ggg"
    List1.ItemData(List1.NewIndex) = 0

    Command1.Caption = "設定非核取項目"
    Command2.Caption = "取消非核取項目"
End Sub

Private Sub List1_MouseDown(Button As Integer, Shift As Integer, X As
Single, Y As Single)
    Label1.Caption = ""
    If Button = 1 Then
        MousePick = List1.ListIndex
        If List1.ItemData(MousePick) = -1 Then
            Label1.Caption = "[" & List1.List(MousePick) & "]不可選取"
        End If
    End If
End Sub

Private Sub List1_MouseUp(Button As Integer, Shift As Integer, X As Single,
Y As Single)
Dim varList() As String, TempString
Dim varItem() As Long, TempNum As Integer
Dim I As Long

    If Button = 1 Then
        If MousePick <> List1.ListIndex Then
            ReDim varList(List1.ListCount - 1)
            ReDim varItem(List1.ListCount - 1)
            For I = 0 To List1.ListCount - 1
                varList(I) = List1.List(I)
                varItem(I) = List1.ItemData(I)
            Next
            TempString = varList(List1.ListIndex)
            varList(List1.ListIndex) = varList(MousePick)
            varList(MousePick) = TempString
            TempNum = varItem(List1.ListIndex)
            varItem(List1.ListIndex) = varItem(MousePick)
            varItem(MousePick) = TempNum
            List1.Clear
            For I = 0 To UBound(varItem)
                List1.AddItem varList(I)
                List1.ItemData(List1.NewIndex) = varItem(I)
            Next
        End If
    End If
End Sub

回索引

一個Frame兩組以上的 Option Buttons

VB 網友問：

如果要在同一個Frame中,可以擁有兩組以上的option buttons...

Peter 答：

在此Frame 中再加兩個 Frame 放 option buutons

老怪插花：

Frame.BorderStyle=0 ，會讓使用者完全感受不到 Frame 的存在。

回索引

用 And 值做 IF 條件判斷

word 撰寫於文章

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
Label1.Caption = "no ascii code"
Label2.Caption = "no ascii code"
Label3.Caption = KeyCode
If Shift And vbShiftMask Then

shift 和 vbshiftmask用and運算邏輯嗎, 還是有其他意義，為何 Shift 和其他按鍵一起按和單獨只按 Shift 都能顯示成立(True)? 這兩件事在vb內部不是對引數 Shift來說不同嗎?

shift數值事件代號

1 單獨按shift vbshiftmask

3 shift+ctrl 　

5 shift+alt 　

!?我真的不懂?!

老怪答：

我們用 IF 判斷式時，判斷條件型態一般是採用 Boolean ，但也可採 Integer or Long ，用 Integer or Long 做判斷條件時，只有判斷條件=0 時才判為 False，其他都是 True。
And 運算是一種包含運算，而不是等於運算，如你自己的例 shift+ctrl=3，則 3 and vbshiftmask 、3 and vbCtrlMask、3 and vbshiftmask+vbCtrlMask 都是 True ，也就是都成立，所以只要一數值包含在另一數值中，And 運算都會是真。
還是一頭霧水？好吧，位元運算開始：
1 and 0=0
1 and 1=1
0 and 0=0
0 and 1=0

這是 and 運算基本法則，你該懂的，不懂趕快翻 VB 運算子的 Help。

我們以 Byte 型態舉例：

0="00000000"

也就是運算出來結果是 "00000000" 的才被判作 False ，其他都是 True。

1="00000001" (vbShiftMask 的值)
2="00000010" (vbCtrlMask 的值)
3="00000011" (Shift+Ctrl 的值)

1 and 3="00000001" and "00000011"="00000001" (結果非 "00000000"，條件判斷為
True)
2 and 3="00000010" and "00000011"="00000010" (結果同上)

至於 3 and 3 不必再舉例了吧。
所以 IF Shift = ShiftCode 是限制運算，只有完全相同條件才成立，IF Shift and ShiftCode 是包含運算，只要其數值包含其中，條件就成立。
並不是所有數值合在一起都可以做 And 運算，例如你的一組數字是 1,2,3,4 ，就無法做 And 運算，因為當系統傳回數值 3 時，倒底代表是同時按 1,2 或只按了 3 ？所以在數值常數宣告時要採用 2^N 的方式來宣告，即 1,2,4,8,16...........，現在你了解 VB 為什麼 Shift =1 ，Ctrl=2 ，Alt=4 了吧，這是很好用的宣告技巧，如果你也想使用 And 運算功能，這種常數宣告方式的技巧你應該學起來。

回索引

TextBox 限輸入數字與小數點

pute 撰寫於文章

利用Keycode來限制鍵盤，用右邊的數字鍵 "Del"的"." keycode=110，因此寫了以下的程式碼，來作限制讓text1只能輸入數字或小數點

Text_keydown()
dim a as long, b as string
for a=1 to len(text1.text)
b=mid(text.text,a,1)
if isnumeric(b)=false then
msgbox"您輸入非數"
end if
end sub
但是我輸入了 12.2 等有小數點的資料之後卻顯示非數字？

老怪答：

你檢查輸入程序應放在 Change 而不是 KeyDown，因為在 TextBox 裏輸入文字，引發事件次序如下：

Keydown

KeyPress

Change

KeyUp

如果你在 KeyDown 裏檢查 Text1.Text ，是檢查未 Change 前的 Text

"." 的 Asc 碼是 46，所以請執行下列程式測試。

Option Explicit
Private Sub Text1_Change()
Dim a As Long, b As String
    For a = 1 To Len(Text1.Text)
        b = Mid(Text1.Text, a, 1)
        If Not (IsNumeric(b) = True Or Asc(b) = 46) Then
            MsgBox "您輸入非數"
            Text1.SetFocus
            '把輸入的非數字刪除
            SendKeys "{BACKSPACE}"
        End If
    Next
End Sub

回索引

列出 Container 容器裏的物件

Alex. Chang. 撰寫於文章

各位先進在這順道請教一下要如何知道 Frame內有那幾個OptionButton呢?(這裏指的是 Runtime時)？

老怪答：

[Function 容器包含物件查詢] 可以查所有收納器的包含物件。
函數呼叫的第一個參數是收納器本身。
函數呼叫的第二個參數是 VB Control 物件全名，必須打正確並注意大小寫。
第二個參數不打表示列出所有包含物件。
[Function 容器包含物件查詢]傳回值是一個物件參照陣列，你可以用接收物件(Index) 來執行被參照物件的一切屬性、方法及事件。
範例如下：
Option Explicit
Private Sub Command1_Click()
Dim 接收物件 As Variant
Dim I As Integer

    On Error GoTo 沒有傳回物件

    接收物件 = 容器包含物件查詢(Frame1, "OptionButton")

    For I = 0 To UBound(接收物件)
        Debug.Print 接收物件(I).Name
    Next

    Exit Sub

沒有傳回物件:
    Select Case Err.Number
        Case 9
            MsgBox "容器錯誤或沒有包含項目"
    End Select
End Sub

Private Function 容器包含物件查詢(ByVal 容器 As Object _
        , Optional ByVal 分類名稱 As String) As Variant
Dim 傳回物件() As Variant
Dim 有指定物件名稱 As Boolean
Dim 物件指標 As Control
Dim AddOne As Integer

    If 分類名稱 = "" Then
        For Each 物件指標 In Me.Controls
            If 物件指標.Container Is 容器 Then
                ReDim Preserve 傳回物件(AddOne)
                Set 傳回物件(AddOne) = 物件指標
                AddOne = AddOne + 1
            End If
        Next
    Else
        For Each 物件指標 In Me.Controls
            If 物件指標.Container Is 容器 Then
                If TypeName(物件指標) = 分類名稱 Then
                    ReDim Preserve 傳回物件(AddOne)
                    Set 傳回物件(AddOne) = 物件指標
                    AddOne = AddOne + 1
                End If
            End If
        Next
    End If

    容器包含物件查詢 = 傳回物件

End Function

回索引

如何處理比螢幕大的 Form

寄件者: sinrue

老怪您好:請教您,編輯FORM1表單已經將它最大化了(全螢幕),但我要編輯的表格卻比它大,也就是說FORM1能不能有畫面捲動的功能設定,還有,我要將FORM1所劃的表格列印下來,windowstate=2 利用form1.printform執行,結果印出來的表格長 and 寬都比原稿小,該怎麼辦?謝謝您指教!

老怪答：

用一個最簡單的辦法解決：

新增一個 MDIForm 。
把你原 Form.MDIChild=True
把你原 Form.WindowsState=0 or 1
當你原 Form 比 MDIForm 大時，自然會有捲軸可拉，也就是說你可以把 Form 設的很大很大(能夠多大沒試過)。
這問題我本來很遲疑要不要收進本篇，因為怕人說老怪沒有範例好寫，開始在灌水了；後來轉念一想，有時很簡單的問題，沒人在旁邊點一下，還真會愈想愈複雜，所以就把此篇當做點一下的範例吧。

回索引

分列中文、英文字型

本範例的技巧是利用 VB stdole 模組中的 StdFont 物件的 Charset 屬性來判別中英字型，StdFont.Charset = 136 的都是中文字型，其他則歸屬英文字型。
另一要注意的是Fixedsys和 System 字型，這兩字型好像是跟著 Windows 語言版本走的,Windows95 中文版中是歸入中文字集的。
本程式只在 Windows95 中文版測試過，若有不正常之處，請來信告知。

VERSION 5.00
Begin VB.Form Form1
   Caption         =   "Form1"
   ClientHeight    =   4140
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   5955
   LinkTopic       =   "Form1"
   ScaleHeight     =   4140
   ScaleWidth      =   5955
   StartUpPosition =   3 '系統預設值
   Begin VB.TextBox Text2
      Alignment       =   2 '靠中對齊
      BeginProperty Font
         Name            =   "新細明體"
         Size            =   14.25
         Charset         =   136
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   615
      Left            =   2760
      MultiLine       =   -1 'True
      TabIndex        =   6
      Top             =   3240
      Width           =   2775
   End
   Begin VB.TextBox Text1
      Height          =   375
      Left            =   240
      TabIndex        =   5
      Text            =   "Text1"
      Top             =   3480
      Width           =   2175
   End
   Begin VB.ListBox List2
      Height          =   2040
      Left            =   2520
      Sorted          =   -1 'True
      TabIndex        =   3
      Top             =   840
      Width           =   1935
   End
   Begin VB.ListBox List1
      Height          =   2040
      Left            =   240
      Sorted          =   -1 'True
      TabIndex        =   2
      Top             =   840
      Width           =   2055
   End
   Begin VB.Label Label3
      Caption         =   "Label3"
      Height          =   375
      Left            =   240
      TabIndex        =   4
      Top             =   3120
      Width           =   2055
   End
   Begin VB.Label Label2
      Caption         =   "Label2"
      Height          =   375
      Left            =   2640
      TabIndex        =   1
      Top             =   480
      Width           =   1695
   End
   Begin VB.Label Label1
      Caption         =   "Label1"
      Height          =   375
      Left            =   240
      TabIndex        =   0
      Top             =   480
      Width           =   1935
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Sub Form_Load()
Dim CheckFont As New StdFont
Dim I As Long
    Label1.Caption = "中文字型"
    Label2.Caption = "英文字型"
    Label3.Caption = "你選用的螢幕字型"
    Text1.Text = "新細明體"
    Text2.Text = "字型效果預覽 ABC"
    Text2.FontSize = 14

    Me.Show
    ChangeVisibleMode
    ShowLogo

    For I = 0 To Screen.FontCount - 1
        CheckFont = Screen.Fonts(I)
        If CheckFont.Charset = 136 Then
            List1.AddItem CheckFont.Name
        Else
            List2.AddItem CheckFont.Name
        End If
    Next
    Me.Cls
    ChangeVisibleMode
End Sub
Private Sub List1_Click()
    Text1.Text = List1.List(List1.ListIndex)
    SetTextFont
End Sub
Private Sub List2_Click()
    Text1.Text = List2.List(List2.ListIndex)
    SetTextFont
End Sub
Private Sub SetTextFont()
    Text2.Font = Me.Font
    Text2.FontSize = 14
    Text2.FontName = Text1.Text
End Sub
Private Sub ChangeVisibleMode()
Dim I As Integer
    For I = 0 To Me.Controls.Count - 1
        Me.Controls(I).Visible = Not Me.Controls(I).Visible
    Next
End Sub
Private Sub ShowLogo()
Dim ShowString As String
Dim Size As Integer
    ShowString = "字型載入中，請稍待。"

    Size = Me.FontSize
    Me.FontSize = 18

    Me.CurrentX = (Me.ScaleWidth - Me.TextWidth(ShowString)) / 2
    Me.CurrentY = (Me.ScaleHeight - Me.TextHeight(ShowString)) / 2

    Me.Print ShowString
    DoEvents

    Me.FontSize = Size
End Sub

回索引

回首頁

shift數值	事件	代號
1	單獨按shift	vbshiftmask
3	shift+ctrl
5	shift+alt

VB5 初級生 老怪範例(五)

分類

標題

大意

作者

日期

VB5 初級生老怪範例(五)