精品久久亚洲_69pao在线成人免费视频_黄色三级网络_亚洲国产精品激情在线观看

您的位置: 首頁 > 源碼資料

vb6(visual basic)常用代碼及說明收集

源碼資料　時間:2015-03-31　作者/發布人:科杰在線　點擊:8923

VB6最大化、最小化命令

Me.WindowState = 0  '0為普通,1為最小,2為最大

當窗口大小化時發生事件
Private Sub Form_Resize() '

如果父窗體被最小化發生事件
If Form1.WindowState = vbMinimized Then

★文本框自動剔除常用符號及空格，只保留漢字及數字的VB代碼

'數字0-9 的Ascii碼是 48-57
'字母A-Z 的Ascii碼是 65-90 小寫字母是 97-122 (下面代碼是使用Ucase函數轉為大寫,所以我97-122從缺)
'漢字 16進制區間 B0A1-F7FE B=66 F=70(下面代碼是使用16進制碼的第一位,其它英文字,數字與符號的16進制第一碼不會在B-F之間)
'添加 Command1
Dim i%, h$, aa$, bb$
Private Sub Command1_Click()
aa = "科！@#杰！@#￥在@！@#@線"
bb = ""
For i = 1 To Len(aa)
h = Hex(Asc(Mid(aa, i, 1)))
If (Asc(Left(h, 1)) >= 66 And Asc(Left(h, 1)) <= 70) Or (Asc(Mid(UCase(aa), i, 1)) >= 65 And Asc(Mid(UCase(aa), i, 1)) <= 90) Or (Asc(Mid(UCase(aa), i, 1)) >= 48 And Asc(Mid(UCase(aa), i, 1)) <= 57) Then
bb = bb & Mid(aa, i, 1)
End If
Next i
MsgBox bb
End Sub

VB6的文本框只能輸入數字和VB只能輸入一小小數點的方法

Private Sub Text1_KeyPress ( KeyAscii As Integer )  
      If KeyAscii > =   Asc ( "0" )   And KeyAscii < =   Asc ( "9" )   Or KeyAscii   =   8 Or KeyAscii   =   Asc ( "." )   Then
            If KeyAscii   =   Asc ( "." )   And InStr ( 1, Text1.Text, ".", vbTextCompare )   > 0 Then
                  KeyAscii   =   0
            End If
            If Text1.SelStart > =   Len ( Text1.Text )   - 2 And _
                  InStr ( 1, Text1.Text, ".", vbTextCompare )   > 0 And _
                  Len ( Text1.Text )   - InstrRev ( Text1.Text, ".", Len ( Text1.Text ) , vbTextCompare )   > =   2 And _
                  KeyAscii <> 8 Then
                   
                  KeyAscii   =   0
            End If
      Else
            KeyAscii   =   0
      End If
End Sub

更強大更實用的限制文本框只能輸入特定字符的方法


調用方法

http://pan.baidu.com/share/link?shareid=214382&uk=1711549925


★VB文本框保留小數點后3位

x = Text2.Text
Text1.Text = Format(x, "0.000")

★vb窗口置頂代碼

Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Const SWP_NOMOVE = &H2 '不更動目前視窗位置
Const SWP_NOSIZE = &H1 '不更動目前視窗大小
Const HWND_TOPMOST = -1 '設定為最上層
Const HWND_NOTOPMOST = -2 '取消最上層設定
Const FLAGS = SWP_NOMOVE Or SWP_NOSIZE

Private Sub Form_Load()
If App.PrevInstance = True Then End '防止程序重復運行
SetWindowPos Me.hwnd, HWND_TOPMOST, 0, 0, 0, 0, FLAGS '窗口置頂
End Sub

★visual Basic 6 如何給窗體窗口加上透明度

'窗口透明度聲明開始
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hwnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
Private Const WS_EX_LAYERED = &H80000
Private Const GWL_EXSTYLE = (-20)
Private Const LWA_ALPHA = &H2
'窗口透明度聲明結束
'窗體透明度開始
Private Sub Form_Activate()
On Error Resume Next
    For i = 0 To 200 Step 5     '0-200是窗體的透明度.從0開始到150.漸漸出現窗體.步長為5
        SetLayeredWindowAttributes Me.hwnd, 0, i, LWA_ALPHA
        DoEvents
    Next i
End Sub   '窗體透明度結束

Private Sub Form_Load()
'窗體透明度開始
 Dim rtn As Long
    rtn = GetWindowLong(Me.hwnd, GWL_EXSTYLE)
    rtn = rtn Or WS_EX_LAYERED
    SetWindowLong Me.hwnd, GWL_EXSTYLE, rtn
    SetLayeredWindowAttributes Me.hwnd, 0, 0, LWA_ALPHA
'窗體透明度結束
End Sub

★用vb獲取一個文件夾中的文件數量
Private WithEvents s As FileListBox
Private Sub Command1_Click()
Text1.Text = "c:\"
    Set s = Controls.Add("VB.FileListBox", "File1")
    With s
        .Visible = False
        .Path = s
        .ReadOnly = True
        .Hidden = True
        .System = True
    End With
    Text1.Text = s.ListCount
    End Sub


★用vb訪問網址的方法

Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Public Sub pc354()
webpc354 = Text1.Text
Call ShellExecute(Me.hwnd, "open", webpc354, "", "", SW_SHOW)
End Sub
Private Sub Command1_Click()
pc354
End Sub

VB點擊文本框自動全選文本

Text1.SelStart = 0
Text1.SelLength = Len(Text1)

怎樣計算文件夾下txt文件的個數？

'添加Text1 Command1
'本代碼不偵測下一層的文件夾,就只搜你在text1里輸入的路徑.
Private Sub Form_Load()
 Text1.Text = "c:\"
End Sub
Private Sub Command1_Click()
 On Error Resume Next
 Dim sSave As String, Ret As Long, r As Long, rtn As Long, kk As Long
 Dim fol, fso, fil, fils, s, f, fldr
 Set fso = CreateObject("Scripting.FileSystemObject")
 Set fldr = fso.GetFolder(Text1.Text)
 Set fils = fldr.Files
 kk = 0
 Me.Cls
 For Each fil In fils
 s = s & fil.Name
 aa = midstr & "\" & fil.Name
 If UCase(Right(aa, 3)) = "TXT" Then
 songname = aa
 i = InStrRev(songname, "\")
 If i > 0 Then
 bb = Mid(songname, i + 1) ' 獲取文件名
 Print bb
 kk = kk + 1
 End If
 End If
 Next
 MsgBox "共有" & Str(kk) & " 個.txt的文件"
End Sub

批量給控件組定義顏色

Private Sub Form_Load()
For ii = 1 To 88
Text1(ii).BackColor = vbWhite
Next
End Sub

將文本文件加載到文本框控件數組中

'建一個按鈕，一個文本框，然后復制這個文本框成數組，文本內容有幾行，就要復制幾個文本框
Private Sub Command1_Click()
Open "c:\1.txt" For Input As #1
Dim i As Integer, s As String
While Not EOF(1)
  Line Input #1, s
  i = i + 1
  Text1(i).Text = s
Wend
Close #1
End Sub

在窗體任意位置點鼠標左鍵可以拖動窗體

Private Declare Function ReleaseCapture Lib "user32" () As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) As Long
Const WM_NCLBUTTONDOWN = &HA1
Const HTCAPTION = 2
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim ReturnVal As Long
    X = ReleaseCapture()
    ReturnVal = SendMessage(Me.hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0)
End Sub

程序窗體沒有標題欄，卻能在任務欄顯示程序名稱的方法

　　把VB窗體fomr1的boderstyle屬性設置為0-none，同時把form1的showintaskbar屬性設置為TRUE

讓按鈕不再顯示出難看的虛線

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Const WM_KILLFOCUS = &H8 '使按鈕失去焦點
Private Sub Form_Activate() 
  Command1_Click
End Sub
Private Sub Command1_Click()
  MsgBox "科杰在線www.yeewaa.com"
  SendMessage Command1.hwnd, WM_KILLFOCUS, 0, 0 '使按鈕失去焦點
End Sub

VB在退出后可以自動保存窗體大小和位置,下次打開時保持

Private Sub Form_Load()
    Me.Width = GetSetting(App.Title, Me.Name, "Width", 7200)
    Me.Height = GetSetting(App.Title, Me.Name, "Height", 6300)
    Me.Top = GetSetting(App.Title, Me.Name, "Top", 100)
    Me.Left = GetSetting(App.Title, Me.Name, "Left", 100)
   
End Sub
Private Sub Form_Unload(Cancel As Integer)
    Call SaveSetting(App.Title, Me.Name, "Width", Me.Width)
    Call SaveSetting(App.Title, Me.Name, "Height", Me.Height)
    Call SaveSetting(App.Title, Me.Name, "Top", Me.Top)
    Call SaveSetting(App.Title, Me.Name, "Left", Me.Left)
End Sub
 
科杰在線www.yeewaa.com收集整理，轉載請注明出處，謝謝
最后修改日期：2015.1.30 12:00
--------------------------全文完----------------------------
0% (0)
0% (0)
整站字母快速檢索： A B C D E F G H I J K L M N O P Q R S T U V W X Y Z 1 2 3 4 5 6 7 8 9 0

綜合報道 經濟形勢 勞動就業 政策法規 熱點推薦 創業新聞 創業指導 創業課堂 創業故事 大學生創業 | 裝修日記 | 學駕駛經歷 | 免費信息發布 | 網站地圖

地址：合肥市臨泉路香格里拉花園 郵箱：pc354@163.com　QQ：55769640 | 皖ICP備06007228號　
版權所有：科杰服務(www.www.yeewaa.com)　建議使用IE7.0或以上版本,最少1280分辨率瀏覽本站,可獲得最佳瀏覽效果

飛到頂部