VB5 範例(10)

VB5 初級生老怪範例(十)

回首頁

分類	標題	大意	作者	日期
物件集合	用 TypeOf 判斷操作指定型態之 Control		老怪	1999/5/18
物件處理	CheckBox.Value 的狀態值		老怪	1999/7/5
圖形處理	簡易統計圖表模擬	Scale 方法的使用	老怪	1999/5/21
圖形處理	使圖片變暗與變亮	PaintPicture OpCode 參數的效果	老怪	1999/5/30
圖形處理	讓圖片隨機出現		老怪	1999/6/1
圖形處理	取得圖檔資訊	Picture 物件的使用	老怪	1999/7/8
視窗界面	如何得知 MDIForm 的子表單都已 Cancel	當 Forms.Count=1	老怪	1999/5/26
檔案 I/O	用 Print # 輸出不加 vbCRLF 結尾的字串	[;] 符號的妙用	璉璉	1999/5/30
檔案 I/O	簡易檔案保全編碼解碼範例	負負得正的 Xor 運算妙用	老怪	1999/6/14
函數處理	自製 MsgBox 對話框	公用模組(Module) 的利用	老怪	2000/5/17

VB5 初級生範例使用說明

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

用 TypeOf 判斷操作指定型態之 Control

Shinji 撰寫於文章

有一程式內有 50 個 textbox 供 user 輸入數字,如何可以知道 50 個數字中那個最大那個最小呢?50個那麼多,唔好叫我一個一個比較呀!

老怪答：

使用 For...Next 迴圈操作 Controls 集合物件。
用 If TypeOf...Is... 判斷式指定使用 TextBox。
範例如下：
Option Explicit

Private Sub Command1_Click()
Dim I As Long
Dim Max As Double, Min As Double

    For I = 0 To Me.Controls.Count - 1
        If TypeOf Me.Controls(I) Is TextBox Then
            Max = Val(Me.Controls(I).Text)
            Min = Val(Me.Controls(I).Text)
            Exit For
        End If
    Next

    For I = 0 To Me.Controls.Count - 1
        If TypeOf Me.Controls(I) Is TextBox Then
            If Max < Val(Me.Controls(I).Text) Then
                Max = Val(Me.Controls(I).Text)
            End If

            If Min > Val(Me.Controls(I).Text) Then
                Min = Val(Me.Controls(I).Text)
            End If
        End If
    Next

    Debug.Print "Max Is:" & Max
    Debug.Print "Min Is:" & Min
End Sub

簡易統計圖表模擬

VERSION 5.00
Begin VB.Form Form1
Caption = "Form1"
ClientHeight = 5535
ClientLeft = 60
ClientTop = 345
ClientWidth = 7395
LinkTopic = "Form1"
ScaleHeight = 5535
ScaleWidth = 7395
StartUpPosition = 3 '系統預設值
Begin VB.CommandButton Command2
Caption = "Command2"
Height = 495
Left = 4800
TabIndex = 5
Top = 4080
Width = 1215
End
Begin VB.CommandButton Command1
Caption = "Command1"
Height = 495
Left = 4800
TabIndex = 4
Top = 3240
Width = 1215
End
Begin VB.TextBox Text1
Height = 495
Index = 2
Left = 5160
TabIndex = 3
Top = 1920
Width = 1575
End
Begin VB.TextBox Text1
Height = 495
Index = 1
Left = 5160
TabIndex = 2
Top = 1200
Width = 1575
End
Begin VB.TextBox Text1
Height = 495
Index = 0
Left = 5160
TabIndex = 1
Top = 480
Width = 1575
End
Begin VB.PictureBox Picture1
BackColor = &H80000009&
Height = 4935
Left = 360
ScaleHeight = 4875
ScaleWidth = 3195
TabIndex = 0
Top = 360
Width = 3255
End
Begin VB.Label Label1
Caption = "第三次成績"
Height = 375
Index = 2
Left = 3960
TabIndex = 8
Top = 2040
Width = 975
End
Begin VB.Label Label1
Caption = "第二次成績"
Height = 375
Index = 1
Left = 3960
TabIndex = 7
Top = 1320
Width = 975
End
Begin VB.Label Label1
Caption = "第一次成績"
Height = 375
Index = 0
Left = 3960
TabIndex = 6
Top = 480
Width = 975
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'本範例在利用 PictureBox 自訂座標方法，製作簡單的 Chart 功能。
Option Explicit

Private Sub Command1_Click()
Dim I As Long

Picture1.Cls
'執行畫格線自訂函數
GridDraw

Picture1.DrawWidth = 3
For I = 0 To 1
'依 TextBox 輸入數值，畫 X,Y 折線
Picture1.Line (3 + (I) * 2, Val(Text1(I).Text))- _
(3 + (I + 1) * 2, Val(Text1(I + 1).Text)) _
, QBColor(Int(Rnd * 16))
Next

Picture1.DrawWidth = 1

End Sub

Private Sub Command2_Click()
Unload Me
End Sub

Private Sub Form_Load()

Command1.Caption = "繪成績曲線"
Command2.Caption = "結束"

'自訂座標刻度，X 軸 0~8，Y 軸 100~-20。
Picture1.Scale (0, 100)-(8, -20)

Randomize
End Sub

Private Sub Picture1_Paint()
GridDraw
End Sub

Private Sub GridDraw()
Dim I As Long

'畫 X 軸
Picture1.Line (1, 0)-(8, 0)
'畫 Y 軸
Picture1.Line (1, 100)-(1, 0)

'畫 X 軸刻度
For I = 0 To 2
Picture1.CurrentX = 2 + I * 2
Picture1.CurrentY = -5

Picture1.Print "第" & CStr(I + 1) & "次"
Next

'畫 Y 軸刻度
For I = 0 To 9
Picture1.CurrentX = 0
Picture1.CurrentY = (I + 1) * 10

Picture1.Print CStr((I + 1) * 10)
Next
End Sub

如何得知 MDIForm 的子表單都已 Cancel

小強尼撰寫於文章

請問我要怎麼知道MDIForm 的child form 已經全被cancel 了呢???

老怪答：

當 Forms.Count=1 ，表示所有 ChildForm 都被 Cancel。

用 Print # 輸出不加 vbCRLF 結尾的字串

(大大的眼睛....) 在 programming 版提到

為什麼 Print # 的輸出總是會在檔案末端加入CR和LF 麻煩知道的人mail一下....謝謝!!

璉璉答：

不要 cr+lf 就加 ";"，Print #hFileHandle, Var 就不會有分段符號。

老怪補：

Private Sub Command1_Click()
Dim Var As String
Dim FileHandle As Integer
    FileHandle = FreeFile
    Open "c:\temp\test.txt" For Output As #FileHandle

    Var = "a"
    Print #FileHandle, Var;
    Var = "b"
    Print #FileHandle, Var;
    Var = "c"
    Print #FileHandle, Var;

    Close #FileHandle
End Sub

回索引

使圖片變暗與變亮

'範例功能：用黑白格線圖當遮罩圖，使畫面明暗化。
'使用控件：Picture1,Picture2、Command1,Command2,Command3
Option Explicit

Private Sub Command1_Click()
    Picture1.Cls
    '用 vbSrcAnd 的方法貼遮罩圖，會使遮罩圖黑色部份被遮蓋，但遮罩圖白色
    '部份則維持原圖樣。也就是讓被貼上的圖一半的圖素變成黑色，
    '達成暗下來的效果
    Picture1.PaintPicture Picture2.Image, 0, 0, , , , , , , vbSrcAnd
End Sub

Private Sub Command2_Click()
    Picture1.Cls
    '用 vbSrcPaint 的方法貼遮罩圖，會使遮罩圖黑色部份不改變，但遮罩圖白色
    '部份則被遮蓋。也就是讓被貼上的圖一半的圖素變成白色，
    '達成亮起來的效果
    Picture1.PaintPicture Picture2.Image, 0, 0, , , , , , , vbSrcPaint
End Sub

Private Sub Command3_Click()
    Picture1.Cls
End Sub

Private Sub Form_Load()
Dim I As Long
    Command1.Caption = "變暗"
    Command2.Caption = "變亮"
    Command3.Caption = "回復"

    Picture1.AutoSize = True

    '提供黑白格線圖之用，不須顯示。
    Picture2.Visible = False

    Picture1.Picture = LoadPicture("d:\image\03.jpg")

    'Scale 改成圖素以利劃線
    Picture2.ScaleMode = 3
    '改成白底黑線
    Picture2.BackColor = RGB(255, 255, 255)
    Picture2.ForeColor = RGB(0, 0, 0)
    With Picture2
        .Width = Picture1.Width
        .Height = Picture1.Height
    End With

    Picture2.AutoRedraw = True
    '畫直線
    For I = 0 To Picture2.ScaleWidth - 1 Step 2
        Picture2.Line (I, 0)-(I, Picture2.ScaleHeight)
    Next
    '畫橫線
    For I = 0 To Picture2.ScaleHeight - 1 Step 2
        Picture2.Line (I, 0)-(I, Picture2.ScaleWidth)
    Next
    Picture2.AutoRedraw = False
End Sub

回索引

讓圖片隨機出現

不會游泳的魚撰寫於文章

我想請問一下..如何利用vb中的圖片控制陣列..讓圖片能隨機出現..

老怪答：

Dim Pic(2) As Picture

Set Pic(0)=LoadPicture("a.bmp")
Set Pic(1)=LoadPicture("b.bmp")
Set Pic(2)=LoadPicture("c.bmp")

Randomize

Set Image1.Pictrue=Pic(Int(Rnd*3))

回索引

簡易檔案保全編碼解碼範例

好大的霧撰寫於文章

我寫了一個通訊錄的程式,把所有資料存入"DATA.DAT"檔,但用"WordPad"即可看到當中的資料,請問可以將資料轉成亂碼或其它型式再存入檔案中達到保密的效果嗎 ?

老怪答：

'範例功能：將文字檔案重編碼，以達成檔案保全的效果。
'基本運作原理：
'1.保全密碼不是由程式運算產生，而是拿任意一張圖片當密碼，也就是縱使別人獲得
'本範例的 Source Code ，如果不知道你用的是那張圖片，密碼還是解不出來。
'2.由於圖片是在設計階段就設定在 PictureBox 的 Picture 屬性裏，所以硬碟中不會
有
'該圖片的檔案。
'執行本範例請於表單上布置 CommonDialog1、Command1,2、Text1 等控制項，並在
'設計階段讓 Picture1.AutoSize=True 後設定一大小適中的圖形。
Option Explicit
'將圖片檔資料載入運算之陣列
Dim SecretBuff() As Byte

Private Sub Command1_Click()
Dim FileHandle As Integer
'文字檔資料的存放陣列
Dim DataBuff() As Byte
    Text1.Text = ""
    CommonDialog1.filename = ""
    CommonDialog1.ShowOpen

    If CommonDialog1.filename = "" Then
        Exit Sub
    End If

    '載入加密後的文字檔
    FileHandle = FreeFile
    Open CommonDialog1.filename For Binary As #FileHandle
    ReDim DataBuff(LOF(FileHandle) - 1)
    Get #FileHandle, , DataBuff
    Close #FileHandle

    '將加密文字檔送到<<解密自訂函數>>中解密
    Text1.Text = ChangeToShowType(DataBuff, SecretBuff)
End Sub

Private Sub Command2_Click()
Dim FileHandle As Integer
Dim DataBuff() As Byte
    CommonDialog1.filename = ""
    CommonDialog1.ShowSave

    If CommonDialog1.filename = "" Then
        Exit Sub
    End If

    '將文字檔送到<<加密自訂函數>>中加密
    ChangeToSecretType DataBuff, SecretBuff, Text1.Text

    Kill CommonDialog1.filename
    '將加密過後的位元組陣列存檔
    FileHandle = FreeFile
    Open CommonDialog1.filename For Binary As #FileHandle
    Put #FileHandle, , DataBuff
    Close #FileHandle

    '使存檔紐失能
    Command2.Enabled = False
End Sub
Private Sub Form_Load()
Dim FileHandle As Integer
    Command1.Caption = "開啟檔案"
    Command2.Caption = "儲存檔案"
    Command2.Enabled = False

    CommonDialog1.Filter = "Special Data(*.Dat)|*.dat|全部檔案(*.*)|*.*"

    '不顯示密碼圖片
    Picture1.Visible = False
    '將密碼圖片存成暫存檔
    SavePicture Picture1.Picture, App.Path & "\~" & App.Title & ".tmp"

    '將圖片檔載入密碼陣列
    FileHandle = FreeFile
    Open App.Path & "\~" & App.Title & ".tmp" For Binary As #FileHandle
    ReDim SecretBuff(LOF(FileHandle) - 1)
    Get #FileHandle, , SecretBuff
    Close #FileHandle

    '刪除密碼圖片暫存檔
    Kill App.Path & "\~" & App.Title & ".tmp"
End Sub
Private Sub Text1_Change()
    '開啟存檔功能
    Command2.Enabled = True
End Sub
'解密自訂函數
'參數說明：
'1.ChangeBuff():要被解密的檔案陣列
'2.MixBuff():密碼陣列
Private Function ChangeToShowType(ByRef ChangeBuff() As Byte, _
        ByRef MixBuff() As Byte) As String
Dim RetString As String
'循環加長密碼陣列長度的陣列
Dim AddBuff() As Byte
Dim I As Long
    '設定密碼加長陣列與被解密的檔案陣列等長
    ReDim AddBuff(UBound(ChangeBuff))

    '如果被解密的檔案陣列較密碼陣列長，那麼此段程式可以將密碼陣列循環重覆。
    For I = 0 To UBound(AddBuff)
        AddBuff(I) = MixBuff(I Mod (UBound(MixBuff) + 1))
    Next

    '將被解密的檔案陣列與密碼陣列的各元素逐一做 Xor 運算，
    '以還原存檔時的重編碼。
    For I = 0 To UBound(ChangeBuff)
        ChangeBuff(I) = ChangeBuff(I) Xor AddBuff(I)
    Next

    '將字串改成 VB 適用的 UniCode 格式。
    RetString = StrConv(ChangeBuff, vbUnicode)
    ChangeToShowType = RetString
End Function
'加密自訂函數
'參數說明：
'1.ChangeBuff():要被加密的檔案陣列
'2.MixBuff():密碼陣列
Private Sub ChangeToSecretType(ByRef ChangeBuff() As Byte, _
        ByRef MixBuff() As Byte, ByVal ChangeString As String)
Dim AddBuff() As Byte
Dim I As Long
    ''將字串改成 Windows 系統登記的字串格式。
    ChangeBuff = StrConv(ChangeString, vbFromUnicode)

    ReDim AddBuff(UBound(ChangeBuff))
    For I = 0 To UBound(AddBuff)
        AddBuff(I) = MixBuff(I Mod (UBound(MixBuff) + 1))
    Next

    '將被加密的檔案陣列與密碼陣列的各元素逐一做 Xor 運算，
    '以利存成檔案時有保全的效果。
    For I = 0 To UBound(ChangeBuff)
        ChangeBuff(I) = ChangeBuff(I) Xor AddBuff(I)
    Next
End Sub

回索引

CheckBox.Value 的狀態值

CheckBox.Value=vbChecked (1,核取)
CheckBox.Valuevb=vbUnchecked (0,未核取)
CheckBox.Valuevb=vbGrayed (2,未決定)

回索引

取得圖檔資訊

'測試本範例請於表單布置 Command1、CommandDialog1
Option Explicit

Private Sub Command1_Click()
'vbPicTypeNone 0 Picture 物件的圖示型態
'vbPicTypeBitmap 1 Picture 物件的點陣圖型態
'vbPicTypeMetafile 2 Picture 物件的中繼檔 ( Metafile ) 型態
'vbPicTypeIcon 3 Picture 物件的圖示型態
'vbPicTypeEMetaFile 4 Picture 物件的加強型中繼檔 ( Enhanced Metafile ) 型態
Dim MyPic As Picture
Dim TypeArray(4) As String

TypeArray(0) = "圖示型態"
TypeArray(1) = "點陣圖型態"
TypeArray(2) = "中繼檔 ( Metafile ) 型態"
TypeArray(3) = "圖示型態"
TypeArray(4) = "加強型中繼檔 ( Enhanced Metafile ) 型態"

CommonDialog1.ShowOpen

Set MyPic = LoadPicture(CommonDialog1.filename)
Debug.Print "圖寬(單位 Pixel)：" & Me.ScaleX(MyPic.Width, vbHimetric, vbPixels)
Debug.Print "圖高(單位 Pixel)：" & Me.ScaleY(MyPic.Height, vbHimetric, vbPixels)
Debug.Print "圖檔型態：" & TypeArray(MyPic.Type)
End Sub

回索引

自製 MsgBox 對話框

MsgBox 函數，是負責啟動及設定 VB 內建的系統對話盒，雖然利用頗稱便利，但總有些人還是嫌它功能不夠，或是外觀單調不好看，所以許多 VB 設計師喜歡自己設計 VB 的對話方塊。不過設計自己的對話方塊時，有一個重要功能，就是 MsgBox 函數可以依使用者在對話框中不同的按鈕，而傳回不同的數植，如果我們自己的 MsgBox 函數沒有這功能，未免太不好用了。

但 MsgBox 這個函數動作卻和一般函數動作有一個十分大的不同，那就是普通函數只在執行程式設計師設計的程式敘述動作，敘述結束將數值回傳即可，但 MsgBox 函數卻是要開個 DialogBox ，然後等使用者按鍵後，再依使用者按鍵決定函數回傳值，如果你用一般的功能函數原理去設計 MsgBox ，最後的結果一定是使用者還沒按鍵，函數就已經執行完畢，所以永遠也沒有機會把使用者的選擇傳回來，而是一直傳回函數的預設值。

解決這個問題的一個簡單辦法是把自製的 MsgBox 函數放到公用模組 (Module) 中去，那麼就會產生一個類似事件通知的效果，可以等待使用者傳回按鍵值。下面是個簡單的範例：

myMsgBox Module:
'myMsgBox 函數的傳回值
Public myMsgBoxReturnValue As Integer
'不同格式對話盒的參照表單物件
Private Box As Form

'自製訊息對話盒
Public Function myMsgBox(prompt, buttons, title) As Integer
'依 buttons 參數選用對話盒格式，frmBox1~3 是三個不同格式的 DialogBox 表單。
Select Case buttons
Case vbOKOnly
Set Box = frmBox1
Case vbOKCancel
Set Box = frmBox2
Case vbAbortRetryIgnore
Set Box = frmBox3
End Select

'這裡必須把 load 和 show 分開做，否則 box 的 prompt 和 title 會是空白的。
Load Box
Box.Caption = title
Box.Label1.Caption = prompt
Box.Show vbModal

'把被對話盒更動的 myMsgBoxReturnValue 公用變數當 mymsgbox 傳回值。
myMsgBox = myMsgBoxReturnValue
End Function
frmBox Form:
Private Sub Command1_Click(Index As Integer)
'把公用變數值設成命令紐索引值，以利 myMsgBox 函數值回傳。
myMsgBoxReturnValue = Index
'隱藏自製的 MsgBox 表單
Me.Hide
End Sub

Private Sub Form_Load()
Command1(0).Caption = "脫離"
Command1(1).Caption = "重試"
Command1(2).Caption = "忽略"
End Sub
Call Function Form:
Private Sub Command1_Click(Index As Integer)
'依命令鈕編號去啟動對應的自製對話盒，並用 label1 接收 myMsgBox 回傳值。
Label1.Caption = myMsgBox("自製訊息對話盒測試", Index, "自製對話盒")
End Sub

Private Sub Form_Load()
Command1(0).Caption = "vbOKOnly"
Command1(1).Caption = "vbOKCancel"
Command1(2).Caption = "vbAbortRetryIgnore"
End Sub

回索引

回首頁

分類

標題

大意

作者

日期