VB5 範例(1)

分類	標題	大意	作者	日期
檔案 I/O	文字檔的定位格式化輸出	Put # & Get # 的使用	老怪	1998/4/30
物件外觀	物件碰撞程式試作(一)	One Timer	老怪	1998/4/30
物件外觀	物件碰撞程式試作(二)	Two Timer	老怪	1998/4/30
圖形處理	如何保留 Paintpictrue 影像	執行Refresh之後圖不見了	老怪	1998/4/29
圖形處理	圖面背景透明的技巧	透明四法	老怪	1998/5/5
圖形處理	區塊取圖與區塊貼圖	PaintPicture() 的參數使用	老怪	1998/5/5
時間換算	日期時間格式的資料型態	以 Now() 函數為例	老怪	1998/5/7
字串處理	用 VB 5.0 算字串長度	StrConv() 的 LenB() 使用	老怪	1998/5/2
字串處理	TextBox 限輸入數字	以 KeyPress Event 為例	老怪	1998/5/15
字串處理	TextBox 限制輸入長度	以 TextBox_Change 為例	老怪	1998/5/20
字串處理	如何顯示 "&" 字元		老怪	1998/5/21
字串處理	數字或字母判斷	IsNumeric() 函數的使用	老怪	1998/5/23
字串處理	突破 TextBox 32 K 的限制	Mid() 函數的使用	老怪	1998/5/23
字串處理	字母轉成循序數字	Asc() 函數的使用	老怪	1998/5/26
字串處理	記事本編輯功能模擬	ClipBoard 物件的使用	老怪	1998/5/26
變數使用	在執行期產生物件	As 和 As New	老怪	1998/5/19
物件引用	使用項目與使用元件的分別		老怪	1998/5/22
隨機取樣	如何把牌洗散洗亂	Randomize 和 Rnd() 使用	老怪	1998/5/23
界面處理	以 Code 刪除字串	Sendkeys 的使用	老怪	1998/5/26
界面處理	TextBox.Text 的全選功能	SelStart & SelLength 屬性	老怪	1998/5/26

VB5 初級生範例使用說明

回索引

如何保留 Paintpictrue 影像

我使用如下的程式碼
Form1.PaintPicture Form2.Picture, 100, 100, Form2.Picture.Width, Form2.Picture.Height, , , , , vbSrcAnd
Form1.Refresh
在第一個statement執行完圖會貼過到form1,但form1執行Refresh之後圖又不見了,請問為何會如此??還有那裡要注意的嗎??

回索引

文字檔的定位格式化輸出

'宣告一個包含五個欄位的自訂形態變數
Private Type Mytype
    FirstName As String * 4
    LastName As String * 4
    ID_No As String * 10
    Salary As Long
    BirthDay As Date
End Type

'存放開檔代號的變數
Dim F_Handle As Integer
'宣告 MyRec 為自訂形態變數
Dim MyRec As Mytype

Private Sub Form_Load()
　'用 Freefile 函數取得開檔代號
　F_Handle = FreeFile()
　' For Random 是採用開隨機檔模式，Len(MyRec) 則是指定每次讀入 Mytype 形態
　'自定變數之寬度
    Open "c:\temp\temp.txt" For Random As #F_Handle Len = Len(MyRec)
　' 隨便輸入些資料，以便觀測寫入檔案之用
    MyRec.FirstName = "嘉"
    MyRec.LastName = "鄭"
    MyRec.ID_No = "A1234"
    MyRec.Salary = 5000
    MyRec.BirthDay = #2/14/60#
　' 用 Put 方法，把 MyRec 裏的資料寫到 "c:\temp\temp.txt" 裏
    Put #F_Handle, 1, MyRec
　'仝上
    MyRec.FirstName = "玉"
    MyRec.LastName = "鄭"
    MyRec.ID_No = "A0034"
    MyRec.Salary = 8000
    MyRec.BirthDay = #5/15/60#
    Put #F_Handle, 2, MyRec

　'用 Get 方法從 "c:\temp\temp.txt" 檔裏拿資料，放到 MyRec 裏。
' [2] 表示取第二筆記錄
Get #F_Handle, 2, MyRec

    Print "[這是第二筆記錄]"
    Print MyRec.FirstName
    Print MyRec.LastName
    Print MyRec.ID_No
    Print MyRec.Salary
    Print MyRec.BirthDay

    Print "[這是第一筆記錄]"
    Print MyRec.FirstName
    Print MyRec.LastName
    Print MyRec.ID_No
    Print MyRec.Salary
    Print MyRec.BirthDay

物件碰撞程式試作(一)

VERSION 5.00
Begin VB.Form flishape
   BackColor       =   &H00FFFF80&
   Caption         =   "Form1"
   ClientHeight    =   3195
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   4680
   LinkTopic       =   "Form1"
   ScaleHeight     =   3195
   ScaleWidth      =   4680
   StartUpPosition =   3 '系統預設值
   Begin VB.Timer Timer1
      Interval        =   1
      Left            =   1800
      Top             =   1320
   End
   Begin VB.Shape Shape2
      BorderWidth     =   3
      FillColor       =   &H000000FF&
      FillStyle       =   0 '實心
      Height          =   855
      Left            =   3360
      Shape           =   4 '圓角矩形
      Top             =   2040
      Width           =   855
   End
   Begin VB.Shape Shape1
      BorderWidth     =   3
      FillColor       =   &H0000FFFF&
      FillStyle       =   0 '實心
      Height          =   855
      Left            =   600
      Shape           =   4 '圓角矩形
      Top             =   240
      Width           =   855
   End
End
Attribute VB_Name = "flishape"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Sub Go_Oridging()
'Shape 歸位方法，目的在改變視窗大小後，_
'避免 Shape 掉到視窗外
    Shape1.Move 0, 0
    Shape2.Move Me.ScaleWidth - Shape2.Width, _
            Me.ScaleHeight - Shape2.Height
End Sub
Private Sub Form_Load()
    Go_Oridging
End Sub

Private Sub Form_Resize()
    Go_Oridging
End Sub

Private Sub Timer1_Timer()
'兩個 Shape 的正負向指標
Static Shp1XFwd As Integer, Shp1YFwd As Integer
Static Shp2XFwd As Integer, Shp2YFwd As Integer
'每步步伐
Static l_go As Integer

    '設定正負向初值
    If Shp1XFwd = 0 Then Shp1XFwd = 1
    If Shp1YFwd = 0 Then Shp1YFwd = 1
    If Shp2XFwd = 0 Then Shp2XFwd = -1
    If Shp2YFwd = 0 Then Shp2YFwd = -1

    l_go = 120

    'Shape1 的邊界處理
    With Shape1
        If .Left <0 Or .Left> Me.ScaleWidth - .Width Then _
                Shp1XFwd = Shp1XFwd * -1
        If .Top <0 Or .Top> Me.ScaleHeight - .Height Then _
                Shp1YFwd = Shp1YFwd * -1
    End With

    'Shape2 的邊界處理
    With Shape2
        If .Left <0 Or .Left> Me.ScaleWidth - .Width Then _
                Shp2XFwd = Shp2XFwd * -1

        If .Top <0 Or .Top> Me.ScaleHeight - .Height Then _
                Shp2YFwd = Shp2YFwd * -1
    End With

    'Shape1 與 Shape2 碰撞處理
    If (Shape1.Left + Shape1.Width - Shape2.Left) > 0 And _
            Shape1.Left <(Shape2.Width + Shape2.Left) And _
            (Shape1.Top + Shape1.Height - Shape2.Top) > 0 And _
            Shape1.Top <(Shape2.Height + Shape2.Top) Then

            '路徑轉向
            Shp1XFwd = Shp1XFwd * -1
            Shp2XFwd = Shp2XFwd * -1
            Shp1YFwd = Shp1YFwd * -1
            Shp2YFwd = Shp2YFwd * -1
    End If

    '移動 Shape1
    Shape1.Move Shape1.Left + (Shp1XFwd * l_go), _
            Shape1.Top + (Shp1YFwd * l_go)
    '移動 Shape2
    Shape2.Move Shape2.Left + (Shp2XFwd * l_go), _
            Shape2.Top + (Shp2YFwd * l_go)

End Sub

物件碰撞程式試作(二)

VERSION 5.00
Begin VB.Form flishape
   BackColor       =   &H00FFFF80&
   Caption         =   "Form1"
   ClientHeight    =   3195
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   4680
   LinkTopic       =   "Form1"
   ScaleHeight     =   3195
   ScaleWidth      =   4680
   StartUpPosition =   3 '系統預設值
   Begin VB.Timer Timer2
      Interval        =   100
      Left            =   2400
      Top             =   1320
   End
   Begin VB.Timer Timer1
      Interval        =   10
      Left            =   1800
      Top             =   1320
   End
   Begin VB.Shape Shape2
      BorderWidth     =   3
      FillColor       =   &H000000FF&
      FillStyle       =   0 '實心
      Height          =   855
      Left            =   3360
      Shape           =   4 '圓角矩形
      Top             =   2040
      Width           =   855
   End
   Begin VB.Shape Shape1
      BorderWidth     =   3
      FillColor       =   &H0000FFFF&
      FillStyle       =   0 '實心
      Height          =   855
      Left            =   600
      Shape           =   4 '圓角矩形
      Top             =   240
      Width           =   855
   End
End
Attribute VB_Name = "flishape"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Sub Go_Oridging()
'Shape 歸位方法，目的在改變視窗大小後，_
'避免 Shape 掉到視窗外
    Shape1.Move 0, 0
    Shape2.Move Me.ScaleWidth - Shape2.Width, _
            Me.ScaleHeight - Shape2.Height
End Sub
Private Sub Form_Load()
    Go_Oridging
End Sub

Private Sub Form_Resize()
    Go_Oridging
End Sub

Private Sub Timer1_Timer()
'Shape 的正負向指標
Static Shp1XFwd As Integer, Shp1YFwd As Integer
'每步步伐
Dim l_go As Integer

    '設定正負向初值
    If Shp1XFwd = 0 Then Shp1XFwd = 1
    If Shp1YFwd = 0 Then Shp1YFwd = 1

    l_go = 120

    'Shape1 的邊界處理
    With Shape1
        If .Left <0 Or .Left> Me.ScaleWidth - .Width Then _
                Shp1XFwd = Shp1XFwd * -1
        If .Top <0 Or .Top> Me.ScaleHeight - .Height Then _
                Shp1YFwd = Shp1YFwd * -1
    End With

    'Shape1 與 Shape2 碰撞處理
    If (Shape1.Left + Shape1.Width - Shape2.Left) > 0 And _
            Shape1.Left <(Shape2.Width + Shape2.Left) And _
            (Shape1.Top + Shape1.Height - Shape2.Top) > 0 And _
            Shape1.Top <(Shape2.Height + Shape2.Top) Then

            '路徑轉向
            Shp1XFwd = Shp1XFwd * -1
            Shp1YFwd = Shp1YFwd * -1
    End If

    '移動 Shape1
    Shape1.Move Shape1.Left + (Shp1XFwd * l_go), _
            Shape1.Top + (Shp1YFwd * l_go)
End Sub

Private Sub Timer2_Timer()
Static Shp2XFwd As Integer, Shp2YFwd As Integer
Dim l_go As Integer

    If Shp2XFwd = 0 Then Shp2XFwd = -1
    If Shp2YFwd = 0 Then Shp2YFwd = -1

    l_go = 120
        'Shape2 的邊界處理

    With Shape2
        If .Left <0 Or .Left> Me.ScaleWidth - .Width Then _
                Shp2XFwd = Shp2XFwd * -1
        If .Top <0 Or .Top> Me.ScaleHeight - .Height Then _
                Shp2YFwd = Shp2YFwd * -1
    End With

    'Shape1 與 Shape2 碰撞處理
    If (Shape1.Left + Shape1.Width - Shape2.Left) > 0 And _
            Shape1.Left <(Shape2.Width + Shape2.Left) And _
            (Shape1.Top + Shape1.Height - Shape2.Top) > 0 And _
            Shape1.Top <(Shape2.Height + Shape2.Top) Then

            '路徑轉向
            Shp2XFwd = Shp2XFwd * -1
            Shp2YFwd = Shp2YFwd * -1
    End If

    '移動 Shape2
    Shape2.Move Shape2.Left + (Shp2XFwd * l_go), _
            Shape2.Top + (Shp2YFwd * l_go)

End Sub

用 VB 5.0 算字串長度

圖面背景透明的技巧

請問一下 vb中的圖面 [背景] 可以設成透明的嘛?? 若可以那要如何用呢???

其實把牌洗散開來，是有它的洗牌模型在的，據老怪所想到的就有下列幾種：

Option Explicit

'宣告撲克牌四個花色的常數
Const CardSpear As Integer = 0
Const CardHeart As Integer = 1
Const CardDimond As Integer = 2
Const CardClub As Integer = 3

'宣告一個存放撲克牌花色、點數的自訂變數型態
Private Type GameCard
    '撲克牌花色
    CardColor As Integer
    '撲克牌點數
    CardNum As Integer
End Type

'宣告存放 52 張撲克牌的變數
Private Poker(51) As GameCard

Private Sub Command1_Click()
'I,J,K 皆做為迴圈計數器使用
Dim I As Long, J As Integer, K As Integer
'TempCard 用為牌資料戶換的暫存區，RndRec 儲存亂數值。
Dim TempCard As GameCard, RndRec As Long
'把花色代表數換回字串的暫存變數
Dim ColorWord As String

    '啟動亂數種子
    Randomize

    '把各花色牌裝進 Poker 陣列裏
    For J = 0 To 3
        For K = 1 To 13
            '純粹防止 Poker 溢位而已，如果你確定自己
            '計算無誤，可以拿掉這個判斷式
            If I > UBound(Poker) Then
                Exit For
            End If

            Poker(I).CardColor = J
            Poker(I).CardNum = K

            I = I + 1

        Next
    Next

    '開始用亂數洗牌，基本的設計原理是假設撲克是放在抽取箱裏，
    '要發牌時再一張張由箱中隨機抽出，依序排好，特色是箱中所有
    '的牌都被抽到一次，而且只會被抽到一次。
    For I = UBound(Poker) To 1 Step -1
        '取一個整數亂數來抽一張牌
        RndRec = Int((I + 1) * Rnd)

        '把選到的牌花色及點數資料交給 TempCard
        TempCard.CardColor = Poker(RndRec).CardColor
        TempCard.CardNum = Poker(RndRec).CardNum

        '把第 I 張牌的資料移到選到的牌上
        Poker(RndRec).CardColor = Poker(I).CardColor
        Poker(RndRec).CardNum = Poker(I).CardNum

        '把 TempCard 裏的資料移到第 I 張牌上
        Poker(I).CardColor = TempCard.CardColor
        Poker(I).CardNum = TempCard.CardNum
    Next

    '把排好的 Poker 顯示一下
    List1.Clear

    For I = 0 To UBound(Poker)
        Select Case Poker(I).CardColor
            Case CardSpear
                ColorWord = "Spear\"
            Case CardHeart
                ColorWord = "Heart\"
            Case CardDimond
                ColorWord = "Dimond\"
            Case CardClub
                ColorWord = "Club\"
        End Select

        List1.AddItem ColorWord & Poker(I).CardNum

        DoEvents

    Next

End Sub

請利用 IsNumeric 函數，並參考下面 Vb Code

Dim I As Long, ShortString As String

    For I = 1 To Len(Text1.Text)
        ShortString = Mid(Text1.Text, I, 1)

        Debug.Print "[" & ShortString & "]" & _
            IIf(IsNumeric(ShortString), "是", "不是") & _
            "數字字串"
    Next

突破 TextBox 32 K 的限制

字母轉成循序數字

用 asc() 函數做判斷：
dim yourword as string*1
dim yourcode as integer

yourword="你輸入的一個字元"

if asc(yourword)>=asc("A") and asc(yourword)<= asc("Z")
yourcode=asc(yourword)-asc("A")+10
end if

debug.print yourcode

以 Code 刪除字串

使用 Sendkeys 陳述式，如下：
'讓 text1 取得焦點，以便接收鍵盤字元。
text1.setfocus
'模擬使用者按下 backspace 按鍵
sendkeys "{Backspace}"

TextBox.Text 的全選功能

Private Sub Text1_Click()
Text1.SelStart = 0
Text1.SelLength = Len(Text1.Text)
End Sub

記事本編輯功能模擬

'複製
Private Sub mnuCopy_Click()
    Clipboard.SetText Text1.SelText
End Sub

'剪下
Private Sub mnuCut_Click()
    Clipboard.SetText Text1.SelText
    Text1.SelText = ""
End Sub

'貼上
Private Sub mnuPaste_Click()
    Text1.SelText = Clipboard.GetText
End Sub

'全選
Private Sub mnuAll_Click()
    Text1.SetFocus
    Text1.SelStart = 0
    Text1.SelLength = Len(Text1.Text)
     Clipboard.SetText Text1.SelText
End Sub

VB5 初級生老怪範例(一)

回首頁

分類

標題

大意

作者

日期