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

您的位置: 首頁(yè) > 源碼資料

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

源碼資料　時(shí)間:2015-03-31　作者/發(fā)布人:科杰在線　點(diǎn)擊:8904

VB6最大化、最小化命令

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

當(dāng)窗口大小化時(shí)發(fā)生事件
Private Sub Form_Resize() '

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

★文本框自動(dòng)剔除常用符號(hào)及空格，只保留漢字及數(shù)字的VB代碼

'數(shù)字0-9 的Ascii碼是 48-57
'字母A-Z 的Ascii碼是 65-90 小寫(xiě)字母是 97-122 (下面代碼是使用Ucase函數(shù)轉(zhuǎn)為大寫(xiě),所以我97-122從缺)
'漢字 16進(jìn)制區(qū)間 B0A1-F7FE B=66 F=70(下面代碼是使用16進(jìn)制碼的第一位,其它英文字,數(shù)字與符號(hào)的16進(jìn)制第一碼不會(huì)在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的文本框只能輸入數(shù)字和VB只能輸入一小小數(shù)點(diǎn)的方法

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

更強(qiáng)大更實(shí)用的限制文本框只能輸入特定字符的方法


調(diào)用方法

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


★VB文本框保留小數(shù)點(diǎn)后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 '不更動(dòng)目前視窗位置
Const SWP_NOSIZE = &H1 '不更動(dòng)目前視窗大小
Const HWND_TOPMOST = -1 '設(shè)定為最上層
Const HWND_NOTOPMOST = -2 '取消最上層設(shè)定
Const FLAGS = SWP_NOMOVE Or SWP_NOSIZE

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

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

'窗口透明度聲明開(kāi)始
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
'窗口透明度聲明結(jié)束
'窗體透明度開(kāi)始
Private Sub Form_Activate()
On Error Resume Next
    For i = 0 To 200 Step 5     '0-200是窗體的透明度.從0開(kāi)始到150.漸漸出現(xiàn)窗體.步長(zhǎng)為5
        SetLayeredWindowAttributes Me.hwnd, 0, i, LWA_ALPHA
        DoEvents
    Next i
End Sub   '窗體透明度結(jié)束

Private Sub Form_Load()
'窗體透明度開(kāi)始
 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
'窗體透明度結(jié)束
End Sub

★用vb獲取一個(gè)文件夾中的文件數(shù)量
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訪問(wèn)網(wǎng)址的方法

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點(diǎn)擊文本框自動(dòng)全選文本

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

怎樣計(jì)算文件夾下txt文件的個(gè)數(shù)？

'添加Text1 Command1
'本代碼不偵測(cè)下一層的文件夾,就只搜你在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) & " 個(gè).txt的文件"
End Sub

批量給控件組定義顏色

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

將文本文件加載到文本框控件數(shù)組中

'建一個(gè)按鈕，一個(gè)文本框，然后復(fù)制這個(gè)文本框成數(shù)組，文本內(nèi)容有幾行，就要復(fù)制幾個(gè)文本框
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

在窗體任意位置點(diǎn)鼠標(biāo)左鍵可以拖動(dòng)窗體

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

程序窗體沒(méi)有標(biāo)題欄，卻能在任務(wù)欄顯示程序名稱(chēng)的方法

　　把VB窗體fomr1的boderstyle屬性設(shè)置為0-none，同時(shí)把form1的showintaskbar屬性設(shè)置為T(mén)RUE

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

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 '使按鈕失去焦點(diǎn)
Private Sub Form_Activate() 
  Command1_Click
End Sub
Private Sub Command1_Click()
  MsgBox "科杰在線www.yeewaa.com"
  SendMessage Command1.hwnd, WM_KILLFOCUS, 0, 0 '使按鈕失去焦點(diǎn)
End Sub

VB在退出后可以自動(dòng)保存窗體大小和位置,下次打開(kāi)時(shí)保持

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收集整理，轉(zhuǎn)載請(qǐng)注明出處，謝謝
最后修改日期：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

綜合報(bào)道 經(jīng)濟(jì)形勢(shì) 勞動(dòng)就業(yè) 政策法規(guī) 熱點(diǎn)推薦 創(chuàng)業(yè)新聞 創(chuàng)業(yè)指導(dǎo) 創(chuàng)業(yè)課堂 創(chuàng)業(yè)故事 大學(xué)生創(chuàng)業(yè) | 裝修日記 | 學(xué)駕駛經(jīng)歷 | 免費(fèi)信息發(fā)布 | 網(wǎng)站地圖

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

飛到頂部