VB5 初級生 老怪範例(四)

回首頁

分類

標題

大意

作者

日期
元件使用 簡易月曆範例 Label 陣列的變化運用 老怪 1998/8/13
物件使用 刪除列印文件 Printer.KillDoc 的方法 老怪 1998/8/18
物件使用 用 Collection 物件啟動表單 用字串 Load Form 老怪 1998/8/18
物件使用 簡易歡迎畫面 Logo Form 老怪 1998/8/18
圖形處理 如何 Paint 出透明背景圖 RasterOp 常數的使用 老怪 1998/8/13
變數處理 副程式與堆疊 　 CWW 1998/8/13
變數處理 變數值遺失 IsMissing() 函數的用途 老怪 1998/8/13
變數處理 自訂型態變數連環套 多層自訂型態變數 老怪 1998/8/20
程式呼叫 避免程式多次執行 App.PrevInstance 的用途 daisy 1998/8/13
字串處理 讓游標在 TextBox 最後一行 當 TextBox 內容改變時 老怪 1998/8/13
字串處理 把字串拆成陣列 Len() & Mid() 老怪 1998/8/15
字串處理 在 TextBox 裏 Format Text_Change & Format() 老怪 1998/8/15
檔案處理 資料夾的複製 FileCopy & MkDir 老怪 1998/8/14
檔案I/O 逐行寫入字串 Print # 陳述的使用 老怪 1998/8/16
檔案I/O VB 的檔案存取模式 不同效果的檔案存取 老怪 1998/8/16
界面外觀 與視窗連動的 Control Form_Resize 的利用 老怪 1998/8/15
常數宣告 在你的程式裏宣告 PI 值 　 Kevin 1998/8/4
錯誤處理 知錯比不錯好 Err 物件的使用 老怪 1998/8/22
錯誤處理 將錯就錯 Resume Next 的妙用 老怪 1998/8/22
程式理念 即時戰略遊戲的原理 Timer 的使用 老怪 1998/8/17

VB5 初級生範例使用說明

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

回索引

簡易月曆範例

'------------  Cut Here  ----------------
VERSION 5.00
Begin VB.Form Form1
   Caption         =   "簡易月曆"
   ClientHeight    =   3945
   ClientLeft      =   4200
   ClientTop       =   2985
   ClientWidth     =   3885
   LinkTopic       =   "Form1"
   ScaleHeight     =   3945
   ScaleWidth      =   3885
   Begin VB.CommandButton cmdShow
      Caption         =   "確定顯示"
      BeginProperty Font
         Name            =   "新細明體"
         Size            =   9
         Charset         =   136
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   2520
      TabIndex        =   5
      Top             =   360
      Width           =   1095
   End
   Begin VB.TextBox txtMonthBox
      Height          =   270
      Left            =   1440
      TabIndex        =   4
      Text            =   "Text1"
      Top             =   600
      Width           =   735
   End
   Begin VB.TextBox txtYearBox
      Height          =   270
      Left            =   1440
      TabIndex        =   3
      Text            =   "Text1"
      Top             =   240
      Width           =   735
   End
   Begin VB.Label lblMonthTitle
      Caption         =   "請輸入月份"
      Height          =   255
      Left            =   240
      TabIndex        =   2
      Top             =   600
      Width           =   975
   End
   Begin VB.Label lblYearTitile
      Caption         =   "請輸入年份"
      Height          =   255
      Left            =   240
      TabIndex        =   1
      Top             =   240
      Width           =   975
   End
   Begin VB.Label lblDay
      Caption         =   "Label2"
      Height          =   495
      Index           =   1
      Left            =   840
      TabIndex        =   0
      Top             =   2160
      Width           =   1215
   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 cmdShow_Click()
    If Not IsNumeric(txtYearBox.Text) Then GoTo DateWrong
    If Val(txtYearBox.Text) < 0 Or Val(txtYearBox.Text) > 9999 Then GoTo
DateWrong
    If Not IsNumeric(txtMonthBox.Text) Then GoTo DateWrong
    If Val(txtMonthBox.Text) < 1 Or Val(txtMonthBox.Text) > 12 Then GoTo
DateWrong
    '執行填入日期副程式
    PutDay Val(txtYearBox.Text), Val(txtMonthBox.Text)

    Exit Sub

DateWrong:

    MsgBox "你日期格式輸入錯誤", vbOKOnly, "日期錯誤"
    '在文字框填上今天的年份
    txtYearBox.Text = Year(Date)
    '在文字框填上今天的月份
    txtMonthBox.Text = Month(Date)

    '執行填入日期副程式
    PutDay Val(txtYearBox.Text), Val(txtMonthBox.Text)
End Sub
Private Sub Form_Load()
Dim I As Integer
Dim XPos As Single, YPos As Single
Dim ColorChoice As Integer
    '設定日期標籤格式
    With lblDay(1)
        .Alignment = 2
        .BackColor = RGB(255, 255, 255)
        .BorderStyle = 1
        .FontSize = 12
        .FontBold = True
        .Width = 495
        .Height = 375
        .Caption = ""
    End With

    '設定第一個日期標籤位置
    XPos = 240
    YPos = 1080
    lblDay(1).Move XPos, YPos
    XPos = XPos + lblDay(1).Width

    '載入其餘標籤，並設定顯示位置
    For I = 2 To 49
        Load lblDay(I)
        lblDay(I).Move XPos, YPos
        lblDay(I).Visible = True
        XPos = XPos + lblDay(1).Width
        If I Mod 7 = 0 Then
            XPos = 240
            YPos = YPos + lblDay(1).Height
        End If
    Next

    '設定星期顯示顏色
    For I = 1 To 49
        ColorChoice = I Mod 7

        Select Case ColorChoice
            Case 0
                lblDay(I).ForeColor = RGB(0, 255, 0)
            Case 1
                lblDay(I).ForeColor = RGB(255, 0, 0)
            Case Else
                lblDay(I).ForeColor = RGB(0, 0, 255)
        End Select
    Next

    '顯示日期標題
    lblDay(1).Caption = "日"
    lblDay(2).Caption = "一"
    lblDay(3).Caption = "二"
    lblDay(4).Caption = "三"
    lblDay(5).Caption = "四"
    lblDay(6).Caption = "五"
    lblDay(7).Caption = "六"

    '在文字框填上今天的年份
    txtYearBox.Text = Year(Date)
    '在文字框填上今天的月份
    txtMonthBox.Text = Month(Date)

    '執行填入日期副程式
    PutDay Val(txtYearBox.Text), Val(txtMonthBox.Text)

End Sub
Private Sub PutDay(ByVal YearValue As Integer, _
        ByVal MonthValue As Integer)
Dim LastDay As Integer, FirstWeekDay As Integer
Dim I As Integer

    '計算每月最後的一天是幾號
    LastDay = Day(DateSerial(YearValue, MonthValue + 1, 0))
    '計算每月的第一天是星期幾
    FirstWeekDay = WeekDay(DateSerial(YearValue, MonthValue, 1), 0)

    '清掉上一次的顯示
    For I = 8 To 49
        lblDay(I).Caption = ""
    Next

    'I 從 7 開始表示避開星期標題標籤
    For I = 7 To LastDay + 6
        lblDay(I + FirstWeekDay).Caption = I - 6
    Next
End Sub
'-------------  End Here ----------------

回索引

如何 Paint 出透明背景圖

段 譽 撰寫於文章

用 Paintpicture方法有個問題...我原本利用gif特性所造出來的透明背景, 透明的部份都被填上白色了..請問有沒有方法能保持原先透明的效果..

老怪答：

  1. 我重測了一遍，Paintpicture 方法沒有問題，在 WMF 和 ICO 檔都能順利去背，只有 GIF 去背圖格式有問題，再一次 MS 又犯了老毛病，在號稱的新增功能上，其實功能支援的不完整。
  2. 如果你覺得  ICO 檔格式限制太大，你可以自製 MetalFile(WMF 檔)，老怪範例第二輯有教你如何自製 MetalFile。
  3. 如果你仍覺得 WMF 不能如你的意，只有採用老怪的最後一招，準備兩張前景完全相
    同，背景一黑一白的兩張圖[要確定是 RGB(0,0,0) 及 RGB(255,255,255)，BMP或Gif
    皆可，JPG 並不適合)，然後執行下列動作：
    Option Explicit

    Private Sub Command1_Click()
        '來源圖與目的圖做 And 布林運算
        Me.PaintPicture Picture1.Picture, 100, 100, , , , , , , vbSrcAnd
        '來源圖與目的圖做 Or 布林運算
        Me.PaintPicture Picture2.Picture, 100, 100, , , , , , , vbSrcPaint
    End Sub

    Private Sub Form_Load()
        '載入白背前景圖
        Set Picture1.Picture = LoadPicture("c:\temp\white.bmp")
        '載入黑背前景圖
        Set Picture2.Picture = LoadPicture("c:\temp\black.bmp")
        '載入 Container 背景圖
        Set Me.Picture = LoadPicture("e:\image\07.jpg")
    End Sub
  4. vbSrcAnd or vbSrcPaint 就是所謂的 RasterOP 參數，共有十三項，可以變化出的效果十分複雜，你有空可以對照 VB Help 的說明自己試看看，在這裏你只要記住下列幾項原則：

回索引

副程式與堆疊

這是一個很少被談起的問題，但不表示不重要，如你對本篇觀念仍有疑問，請向 CWW 請教http://sunh.hosp.ncku.edu.tw/~cww/。

老怪於 1998/8/11：

我如果用下列程式碼模擬滑鼠連發動作，則按下滑鼠啟動迴圈，放開滑鼠就停止迴圈，一切如我預期：
Dim Working As Boolean
Private Sub ContinueClick()
Dim I As Long
    Do While Working
        I = I + 1
        Label1.Caption = I
        DoEvents
    Loop
End Sub
Private Sub Command1_MouseDown(Button As Integer, Shift As Integer, X As
Single, Y As Single)
    Label1.Caption = ""
    Working = True
    ContinueClick
End Sub
Private Sub Command1_MouseUp(Button As Integer, Shift As Integer, X As
Single, Y As Single)
    Working = False
End Sub

但如果我用下例，則放開滑鼠後，迴圈不會停止：

Private Sub ContinueClick(byval Working as boolean)
Dim I As Long
    Do While Working
        I = I + 1
        Label1.Caption = I
        DoEvents
    Loop
End Sub
Private Sub Command1_MouseDown(Button As Integer, Shift As Integer, X As
Single, Y As Single)
    Label1.Caption = ""
    ContinueClick true
End Sub
Private Sub Command1_MouseUp(Button As Integer, Shift As Integer, X As
Single, Y As Single)
    ContinueClick False
End Sub

似乎在迴圈中的程式，在未結束前跟本不理會傳進來的參數，或是另有原因，請知道的人替我解惑一下。

CWW 於 1998/8/12：

呼叫ContinueClick False時，代表另外起一個stack 在做ContinueClick的事，所以它一始working = false所以就結束了，而ContinueClick True的那一段程式碼還在執行，所以不會停，您可以Debug看一看就知道，中斷點在ContinueClick False而後按F8。否則，請改用以下方式就可以

Private Sub ContinueClick(ByVal Working As Boolean)
Dim I As Long
Static conti As Boolean
conti = Working
    Do While conti
        I = I + 1
        Label1.Caption = I
        DoEvents
    Loop
End Sub
Private Sub Command1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Label1.Caption = ""
    ContinueClick True
End Sub
Private Sub Command1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
ContinueClick False
End Sub

老怪於 1998/8/12

Private Sub ContinueClick(ByVal Working As Boolean)
Dim I As Long
Static conti As Boolean
'為何加這個就可以咧，還是不太懂。
conti = Working
'........................................
End Sub

CWW於 1998/8/13

static 並不是放在堆疊內的變數，所以一經設定，不但影響ContinueClick False的那一沒程式碼，連同ContinueClick true所引發的那段程式也因conti = false而令迴圈中止。

老怪的理解：

  1. 副程式的變數資料是在被呼叫後，才臨時給一個堆疊，放置副程式所需資料。
  2. 雖然我們是呼叫同一個副程式，但若一個副程式被同時呼叫兩次，它是各有各的堆疊，不會共用的。
  3. 副程式中的靜態變數，並不是放入堆疊中，而是另有固定存放位置，所以才能在副程式結束後，仍保有其值。
  4. 感謝 CWW 對老怪這種半吊子程式人的指導。

回索引

避免程式多次執行

(小恩) 的文章中提到:

我用 VB 寫了一個程式！要怎麼判斷程式已經執行了呢？

daisy：

在form load 中加入

If App.PrevInstance = True Then  '避免程式多次執行
        End
End If

回索引

變數值遺失

寄件者: 何承穎

什麼是 if Not IsMissing() then

老怪答：

  1. IsMissing() 是個檢查變數型態的函數，它最簡單的解釋就是變數型態遺失，也就是本來它可以藉由指定的敘述式指定某變數型態，結果這個動作沒有被執行，就產生了 IsMiissing 的狀態，傳回值是 True or False。

  2. 聽不懂，沒關係，不要說你看的人看不懂，我寫的人一樣看不懂，如果你是程式語言初學者，會懂那是天才。

  3. 因此不講太多理論，只講實際應用，我們可以只問 IsMissing() 這函數到底什麼時候會False，什麼時候會 True。

  4. 什麼時候 IsMissing()=True：

回索引

讓游標在 TextBox 最後一行

Private Sub Command1_Click()
Text1.Text = "HoneyPie 問" + vbCrLf
Text1.Text = Text1.Text + _
"text1 這個 textbox 的 text 屬性改變了" + vbCrLf
Text1.Text = Text1.Text + _
"我希望游標能一直在最後一行" + vbCrLf
Text1.Text = Text1.Text + _
"不知道怎麼做到? 謝謝"

Text1.SetFocus
End Sub


Private Sub Text1_Change()
'重點!!這樣可以把遊標放到 Text 的結尾
Text1.SelStart = Len(Text1.Text)
End Sub

Text1.MultyLine=true
text1.scrollbars=2
這兩個屬性要先在設計階段設好，因為它們無法用程式敘述來改變。

回索引

資料夾的複製

daisy 撰寫於文章

請問vb5.0如何把一個資料夾搬到另一個地方去，還有如何知道一個資料夾是否被存在?

老怪答：

Private Sub Command1_Click()
Dim SourcePath As String, TargetPath As String
Dim CheckString As String

    '設定檔案複製之來源及目的
    SourcePath = "c:\icons"
    TargetPath = "c:\tempb"

    '檢查來源路徑是否存在
    CheckString = Dir(SourcePath, vbDirectory)
    '不存在顯示 MsgBox 訊息
    If CheckString = "" Then GoTo FileNotFound

    Me.MousePointer = 11

    '檢查目的路徑是否存在
    CheckString = Dir(TargetPath, vbDirectory)
    '不存在則 MkDir
    If CheckString = "" Then
        MkDir TargetPath
    End If

    '為來源路徑字串尾加 "\" 字串(才能向下搜尋)
    If Right(SourcePath, 1) <> "\" Then
        SourcePath = SourcePath + "\"
    End If

    '為來源路徑字串尾加 "\"
    If Right(TargetPath, 1) <> "\" Then
        TargetPath = TargetPath + "\"
    End If

    '重新設定一次 Dir 啟始路徑
    CheckString = Dir(SourcePath)

    '找不到檔案了才結束
    Do While CheckString <> ""
        If Not (CheckString = "." Or CheckString = "..") Then
            FileCopy SourcePath & CheckString, TargetPath & CheckString
            CheckString = Dir
        End If
    Loop

    Me.MousePointer = 0

    Exit Sub
FileNotFound:
    MsgBox SourcePath & " 目錄不存在", vbOKOnly, "檔案路徑錯誤"

End Sub

以上只是一層目錄的檔案 Copy ，若要含所有下層子目錄檔案，請到CWW http://sunh.hosp.ncku.edu.tw/~cww/ VB心得筆記找一篇子目錄檔案搜尋的範例。

回索引

把字串拆成陣列

勇敢的海王子 撰寫於文章

如果我想把text1.text設成一個字串陣列，是不是直接寫成

老怪答：

你這樣的寫法是宣告長度為 11 (1~10) 的一個陣列，並把 Text1.Text 放進第十一個陣列裏，並不是把 Text1.Text 拆成單字放在 S() 裏的意思，要做到拆字串，請參考下例：

Dim S() As String * 1
Private Sub Command1_Click()
Dim I As Long
    For I = 0 To Len(Text1.Text)
        ReDim Preserve S(I)
        S(I) = Mid(Text1.Text, I + 1, 1)
        Print S(I)
    Next
End Sub

藉由 S() 動態陣列宣告，及 Redim S() 陣列長度，可以做出剛好符合 Text1.Text 長度的陣列。

回索引

與視窗連動的 Control

阿志 撰寫於文章

請問我如何設計程式，使得我的視窗內容也會跟著改變。例如當我改變視窗大小時，我要視窗內的FRAME,PICTURE,TOOLBAR也跟著比例作用。

老怪答：

  1. Option Explicit

    Dim OldWidth As Single
    Dim OldHeight As Single

    Private Sub Form_Load()
    '記錄原來 Form 的長、寬
    OldWidth = Me.ScaleWidth
    OldHeight = Me.ScaleHeight
    End Sub

    Private Sub Form_Resize()
    Dim XScale As Single
    Dim YScale As Single
    Dim I As Integer

    '換算原視窗大小與新視窗大小的比例
    XScale = Me.ScaleWidth / OldWidth
    YScale = Me.ScaleHeight / OldHeight

    '如該控制項沒有 Font 屬性則跳下一個
    On Error Resume Next
    '移動並調整控制項大小
    For I = 0 To Me.Controls.Count - 1
    With Me.Controls(I)
    Select Case TypeName(Me.Controls(I))
    Case "Line"
    .X1 = .X1 * XScale
    .X2 = .X2 * XScale
    .Y1 = .Y1 * YScale
    .Y2 = .Y2 * YScale
    Case Else
    .Move .Left * XScale, .Top * YScale, _
    .Width * XScale, .Height * YScale
    .FontSize = .FontSize * (XScale + YScale) / 2
    End Select
    End With
    Next
    '記錄新視窗大小
    OldWidth = Me.ScaleWidth
    OldHeight = Me.ScaleHeight
    End Sub
  2. 如何與視窗連動 Control，恐怕永遠不會有一個通體適用的辦法，因為每個元件被設計師製成時，如果採用了不同於一般 VB 控制項的外觀調整模式，就表示你必須多處理一種例外狀況。我自知此範例不是一個完美答案(因為永遠會有例外)，但起碼先解決一些大部份的控制項調整工作，再依表單使用的元件作例外處理，可以使這個繁雜的問題可以有個著手的方向。

回索引

在 TextBox 裏 Format

二姐 撰寫於文章

想請教一下 在 TextBox Edit 期間順便format如何作，例如 敲1234  ==> 1,234 而且會右靠...

老怪答：

Private Sub Text1_Change()
    Text1.Text = Format(Text1.Text, "#,###")
    Text1.SelStart = Len(Text1.Text)
End Sub

注意：請先在設計階段設定好

  1. Text1.Alignment=1
  2. Text1.Multiline=True

回索引

逐行寫入字串

Cheng Tom 撰寫於文章

如何將數個 Label 中的資料 (Caption)存入一 .TXT 標準格式的文字檔中？

老怪答：

Private Sub Command1_Click()
Dim FileHandle As Integer
Dim I As Integer
Dim PutString As String
    FileHandle = FreeFile

    Open "c:\temp\label.txt" For Output As #FileHandle

    For I = 0 To Label1.Count-1
        PutString = PutString + Label1(I)
    Next

    Print #FileHandle, PutString

    Close #FileHandle
End Sub

Private Sub Form_Load()
    Label1(0).Caption = "如何將數個 Label 中的資料"
    Label1(1).Caption = "(Caption) 存入一 .TXT"
    Label1(2).Caption = " 標準格式的文字檔中？"
End Sub

回索引

PI 值

pony 撰寫於文章

請問 VB5 有沒有 PI 這個常數

Kevin 答：

沒有，不過 const pi = 3.14159265358979應該已經過精確了吧...你也可以用pi = 355/113 (密率，不是那麼準...)。

老怪插花：

建一個 MyOwn.bas，在裏面宣告 Public Const user_PI As Double = 3.14159265358979，好了，以後你的程式就可以有 PI 這個常數了。

回索引

知錯比不錯好

老怪：

  1. 在 VB 5.0 內建物件裏，有一個 Err 物件，主要是負責程式動作執行錯誤的偵測。它的原理就是當出現程式動作無法執行，或是沒收到應有的訊息時，回應程式一個訊息，要求程式加以處理，如果程式不處理，它就把程式結束，以免危及作業系統的穩定。
  2. 或許你說那寫個毫無錯誤的程式，不就不需要這個東西了嗎？其實這想法不切實際，因為應用程式交到使用者手上，它的操作不可能不出錯，舉凡軟碟機門沒關、網路連線逾時，資料傳送中斷.....等等，狀況百出，無奇不有。所以做為一個程式設計師一開始設計程式就應該假定使用者會出錯，然後想法子解決這些狀況。
  3. 要解決錯誤狀況，就要靠 Err 物件通知，但如何才收的到 Err 通知？那就要在我們的副程序裏加入 On Error 敘述如下：
    Private Sub Form_Load()
    On Error ..........
    '程式敘述.................
    End Sub
  4. On Error 代表我們要接收錯誤通知，但接收到要怎麼處理呢？一般最常用的有下列兩種：
  5. On Error 不只對它後面一行的程式敘述有效，而是對整個副程序都有效，也就是說你只要在 Procedure 開始執行 On Error 敘述，除非其後有另一個 On Error 取代它，否則整個 Procedure 都將遵循 On Error 宣布的處理法則。
  6. Err 物件最方便利用的兩個屬性是 Err.Number 和 Err.Description，你在錯誤處理前先執行 Debug.print "錯誤代碼：" & Str(Err.Number) & " \ 錯誤敘述：" & Err.Description 將會協助你了解問題發生的狀況及判別方法。

回索引

將錯就錯

老怪：

回索引

即時戰略遊戲的原理

(inkfish)之銘言：

  1. 玩過紅色警戒這類"即時戰略"的玩家都應該知道它的玩法，也就是我方可不斷移動單位來部屬或是作戰，同一時間內電腦所控制的玩家也同時進行這兩項動作。
  2. 問題來了，假如大家還沒忘記的話 當時紅色警戒上市時還是 80486 CPU，加上 DOS 6.x的作業系統 換句話說 當時的DOS 還不是一個多工的系統，但是紅色警戒玩起來卻煞有其事 好像有多工的樣子(戰車可自由移動不須電腦動玩才能動 換言之 沒有回合的限制)
  3. 所以請問一下 要如何在一個沒有多工的系統上模擬出一個多工的樣子?假如改在現在的多工作業平台 如WIN95以上的系統要如何做到此一功能呢?thread嗎?

老怪答：

這跟多工什麼關係咧，別把問題攪的那麼複雜。

  1. 這叫棋子操縱模式。
  2. 回合制採用分別棋子操縱模式，也就是敵方棋子由電腦操縱，使用者棋子由使用者操縱。
  3. 即時制採用統合棋子操縱模式，也就是雙方棋子都由電腦操作，只是電腦允許使用者改變我方棋子行為模式而已。
  4. 我們可以這麼想，電腦由一個時間器(Timer) 隔一段時間去動一下敵我雙方的所有旗子，也就是說使用者如果不動作，其實就是看電腦自己在下棋。
  5. 但一旦使用者指定某棋子時，該棋子移動指標就被標為 False ，如此電腦在每一棋步中碰到該棋子就不會對它有所動作，但其他棋子則繼續動作，直到使用者設定完該棋子行動方式後，行動指標恢復為 True ，意思就是繼續交還電腦控管。
  6. 用一個最簡單的 VB 模型來說明：

    Type 棋子模式
        行動指標 As Boolean
        行為模式 As SomeValue
    End Type

    '假設有十顆棋子
    Dim 棋子(9) AS 棋子模式

    Sub Form_Load()
    Dim I As Long

        棋子(0).行為模式=敵A
        棋子(1).行為模式=敵B
        .
        .
        棋子(5).行為模式=我A
        棋子(6).行為模式=我B
        .
        .
        For I=0 To Ubound(棋子)-1
            棋子.行動指標=True
        Next
    End Sub

    Sub 棋子_Click(Index As Integer)
        棋子(Index).行動指標=False
        Call 行為模式改變(Index)
    End Sub

    Sub 行為模式改變(Byval 傳入值)
        '...............行為模式改變設定
        棋子(傳入值).行為模式 =新行為模式
         棋子(傳入值).行動指標=True
    End Sub

    Sub Timer_Timer()
    Dim I As long
        For I=0 to UBound(棋子)-1
            If 棋子(I).行動指標=True Then
               Call 棋子行動 (棋子(I).行為模式)
            End If
        Next
    End Sub

    Sub 棋子行動(ByVal 傳入值)
        Select Case 傳入值
            Case 敵A
                敵A 模式行動展開
            Case 敵B
                敵B 模式行動展開
            .
            .
            Case 我A
                我A 模式行動展開
            Case 我B
                我B 模式行動展開
            .
            .
    End Sub

    至於戰車跑幾步，士兵發幾槍，被 K 多少下才會陣亡 ，可借行為模式的增加來設定，不過這種各兵種不同屬性的設定，不管回合制或即時制都需要有此種機制，不構成雙方分別的要件。

#上例純為一種構想模式，請不要把這些 Copy 到 Form 裏執行。#

回索引

刪除列印文件

寄件者: richo

小弟的程式碼如下：
Private Sub CancelPrint_Click()
     printer.killdoc
end sub
情況是：程式執行中按下此CancelPrint按鍵後，印表機依樣將欲取消列印之資料印出。

老怪答：

Printer.KillDoc 要在 Printer.EndDoc 之前才能終止列印，一旦你 EndDoc ，就沒辦法取消了，你可以分別測試 EndDoc 之前的 KillDoc，和 EndDoc 之後的 KillDoc ，並把印表機視窗開在旁邊，你就會看出兩者不同了。

回索引

用 Collection 物件啟動表單

雲淡風輕

是否可以將form的name傳到一個function，然後load這個form呢？

老怪答：

  1. 先用一個 Module 寫入下列敘述，並把專案啟動物件改為 Sub Main

    Option Explicit

    '宣告一個集合變數，準備把所有的專案 Form 物件丟進來
    Public FormCollect As New Collection

    Sub Main()
    Dim varForm As Form

        '在這裏寫明你專案中所有的表單
        Set varForm = New Form1
        '把 Form1 的參照物件丟到 FormCollect 集合物件裏，
        '把索引鍵設為 Form.Name
        FormCollect.Add varForm, "Form1"

        Set varForm = New Form2
        FormCollect.Add varForm, "Form2"

        Set varForm = New Form3
        FormCollect.Add varForm, "Form3"

        '取出 Form1 參照，做為第一個顯示表單
        FormCollect.Item("Form1").Show
    End Sub
  2. 在你第一個顯示表單裏做下面的敘述，就可以以名稱啟動所有表單

    Option Explicit

    '依傳入字串決定表單啟動的副程序
    Private Sub ShowForm(ByVal varFormName As String)
    Dim I As Integer

        '逐筆核對表單是否已載入
        For I = 0 To Forms.Count - 1
            '如已載入則警告
            If Forms(I).Name = varFormName Then
                MsgBox "表單已載入"
                Exit Sub
            End If
        Next

        '把同名的表單參照顯現出來
        FormCollect.Item(varFormName).Show
    End Sub

    '選一個表單載入
    Private Sub Combo1_Click()
        ShowForm Combo1.List(Combo1.ListIndex)
    End Sub

    Private Sub Form_Load()
    Dim I As Integer

        '把表單參照名稱丟到 Combo1 裏
        For I = 1 To FormCollect.Count
            '注意，當你引用一未載入表單之屬性時，
            '表單會自動載入
            Combo1.AddItem FormCollect.Item(I).Name
        Next

        '把自動載入的表單 UnLoad ，以節省記憶體
        For I = 0 To Combo1.ListCount - 1
            '自己的表單不要 UnLoad
            If Not Combo1.List(I) = Me.Name Then
                Unload FormCollect.Item(I + 1)
            End If
        Next
    End Sub

    Private Sub Form_Unload(Cancel As Integer)
        '強迫表單關閉
        UnLoad Me
    End Sub
  3. 這一段牽涉了很多 Forms 及 Form_Load 的基本觀念，老實說要不是雲淡風輕這麼問，我也不會想到可以這樣做，我可以這麼跟大家說，在別的教科書及課堂講義很少這麼教的(或許我孤漏寡聞沒看過)，所以請各位初學版友一定自己要 Copy 下來試試看，有那部份不懂 Post 上來問，我再詳細解釋，而此例之所以重要，是因為你可以用這種方式，以 Name String 輕易的操縱大部份的 VB 物件，而那些物件要加入動作，那些物件要排除動作，藉著 Collection 的 Add 和 Remove 可以輕易達成。
  4. Collection 集合物件變數是 VB 裏功能超級強大的物件類型，不只有 Variant 的什麼變數都包的特性，比 Variant 更強的是它提供了除 Index 之外 Key 值可供取出物件內容，但很少看到 VB 版友的 Code 有在用 Collection 的，如果你還沒用過Collection ，希望你趕快翻 Help ，試著使用。

回索引

簡易的歡迎畫面

走過四方回到原點 撰寫於文章

像是歡迎畫面等表單 我想把它設定成第一張要怎麼做啊？

老怪答：

  1. Option Explicit

    Private Sub Form_Load()
    Dim MyTime As Date
    Dim ShowString As String
        ShowString = "歡迎進入" & vbCrLf & _
                "走過四方的" & vbCrLf & _
                "世界"

        '調整 form1 大小
        With Me
            .FontSize = 36
            .Width = .TextWidth(ShowString) + 10 * Screen.TwipsPerPixelX
            .Height = .TextHeight(ShowString) + 10 * Screen.TwipsPerPixelY
            .Show
        End With

        '強迫表單顯現，不然會不顯示就結束了
        Me.Show
        Me.CurrentX = 5 * Screen.TwipsPerPixelX
        Me.CurrentY = 5 * Screen.TwipsPerPixelY
        '秀字
        Me.Print ShowString

        MyTime = Timer
        '停格三秒
        Do While Timer - MyTime < 3
            DoEvents
        Loop

        Form2.Show
        Unload Me
    End Sub
  2. 記得加入 Form2 ，然後把上述程式碼加在 Form1 裏，Form1.BorderStyle 最好等於 0 ，效果會比較好。當然，Form1 只是秀一下而已，所以不要太複雜，主程式放 Form2裏。

回索引

自訂型態變數連環套

蠟筆小星星 撰寫於文章

請問VB5中定義自訂型態中可不可再定義另一個自訂type

老怪答：

  1. 可以。
  2. 請看範例：
    Option Explicit

    Private Type First
        FirstName As String
        LastName As String
    End Type

    Private Type Second
        Name As First
        Salary As Long
        Age As Integer
    End Type

    Dim MyMan As Second

    Private Sub Form_Click()
        Print MyMan.Name.LastName + MyMan.Name.FirstName + _
                "今年 " + Str(MyMan.Age) + " 歲，每月收入 " _
                + Str(MyMan.Salary) + " 元"
    End Sub

    Private Sub Form_Load()
        MyMan.Name.FirstName = "怪"
        MyMan.Name.LastName = "老"
        MyMan.Age = 38
        MyMan.Salary = 0
    End Sub

回索引

VB 的檔案存取模式

寄件者: James Wu

主旨: 請問：欲將字串存入檔案中，要如何除去首尾的雙引號，使雙引號不存入呢？

老怪答：

VB File I/O 有幾種模式是成對使用的：

  1. Get# and Put# 隨機存取
  2. Input# and Write# 循序存取格式化文字檔
  3. LinePut# and Print# 循序存取非格式化文字檔
  4. InPut() 函數，載入一切文字檔含格式化字元。
  5. 你寫檔會加引號應是用 Write# 模式，如不欲格式化請用 Print#
  6. 請熟悉各種讀寫方式的不同。

回索引

回首頁

1