午夜精品视频_国产精品一二_99一区二区_亚洲欧洲日本mm_好吊色欧美一区二区三区四区_午夜一区二区三区不卡视频_蜜桃av综合_精品不卡在线_欧美一级久久_国产精品v欧美精品∨日韩

vb6根據系統語言，控件顯示不同文字的代碼

Option Explicit
Private Declare Function GetSystemDefaultLCID Lib "kernel32" () As Long
Private Sub Form_Load()
    Dim lcid As Long
    lcid = GetSystemDefaultLCID()
    Select Case lcid
        Case &H804 ' 簡體中文
            Command1.Caption = "中國"
        Case &H404 ' 繁體中文（臺灣）
            Command1.Caption = "中國"
        Case Else ' 其他語言
            Command1.Caption = "china"
    End Select
End Sub

VB6.0最簡單代碼實現中文簡繁體轉換

Private Declare Function LCMapString Lib "kernel32" Alias "LCMapStringA" (ByVal Locale As Long, ByVal dwMapFlags As Long, ByVal lpSrcStr As String, ByVal cchSrc As Long, ByVal lpDestStr As String, ByVal cchDest As Long) As Long
Private Sub Command2_Click() '簡體與繁體轉換
  Text2 = change(Text1, 1)
End Sub
Private Sub Form_Load()
  Text1.Text = "科杰在線pc354.com"
  'Text1.ForeColor = RGB(100, 0, 211)
End Sub
Public Function change(ByVal cString As String, ByVal nMode As Integer) As String
    Dim nLen As Long
    nLen = LenB(cString)
    change = Space(nLen)
    Select Case nMode
        Case Is = 0 '繁體轉簡體
            LCMapString &H804, &H2000000, cString, nLen, change, nLen
        Case Is = 1 '簡體轉繁體
            LCMapString &H804, &H4000000, cString, nLen, change, nLen
    End Select
End Function

替換字符串

Text1.Text = Replace(Trim(Text1.Text), "e", "")
d = Replace(Trim(d), "\\", "\")
d = Replace(Trim(d), "\WeChat Files\WeChat Files\", "\WeChat Files\")

替換字符串中帶不帶Trim的區別：帶Trim表示會自動清除文本開頭和結尾的空格后再替換字符

text1.text="  中華人民共和國  "
Text2.Text = Replace(Text1.Text, "中華", "中國")
Text3.Text = Replace(Trim(Text1.Text), "中華", "中國")

VB6鼠標可以隨意拖動的窗體

Dim movesScreen As Boolean
Dim mousX As Integer
Dim mousY As Integer
Dim currX As Integer
Dim currY As Integer

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = 1 Then
        movesScreen = True
        mousX = X
        mousY = Y
    End If
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If movesScreen Then
        currX = Form1.Left - mousX + X
        currY = Form1.Top - mousY + Y
        Form1.Move currX, currY
    End If
End Sub

Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    movesScreen = False
End Sub

VB6最大化、最小化命令

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

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

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

如何在VB中實現按ctrl+A后，全選文本框中的文字

Private Sub Text1_KeyPress(KeyAscii As Integer)
  If KeyAscii = 1 Then
   Text1.SelStart = 0
   Text1.SelLength = Len(Text1.Text)
  End If
End Sub
或者用這個

Private Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer)
  If Shift = 2 And (KeyCode = Asc("a") Or KeyCode = Asc("A")) Then
    Text1.SelStart = 0
    Text1.SelLength = Len(Text1.Text)
  End If
End Sub

★文本框自動剔除常用符號及空格，只保留漢字及數字的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_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

vb 鼠標進入窗體和離開窗體的事件怎么寫？

Private Declare Function SetCapture Lib "user32" (ByVal hwnd As Long) As Long

Private Declare Function ReleaseCapture Lib "user32" () As Long

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
 If 0 <= X And X <= Form1.Width And 0 <= Y And Y <= Form1.Height Then
  SetCapture Form1.hwnd '已進入
  Label1.Caption = "鼠標進入" '這里就是鼠標進入后觸發
  Else
  ReleaseCapture '這里就是離開
  Label1.Caption = "鼠標離開"'這里是鼠標離開后觸發
  End If
End Sub

vb 打開文件（圖片、office文檔等）

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
Private Sub Command1_Click()
SW_SHOWNORMAL = 1
Call ShellExecute(Me.hwnd, "open", "d:\a.png", vbNullString, vbNullString, SW_SHOWNORMAL)
End Sub

注：   Shell "explorer.exe /select, " & “d:\”, vbNormalFocus  '只能打開文件夾、bat、exe等文件

vb 判斷文件有沒有被打開并執行相應動作

Private Sub Command1_Click()
    On Error Resume Next
    Err.Clear
    If Dir("d:\a.xlsx") <> "" Then
        Name "d:\a.xlsx" As "d:\a2.xlsx"
    End If
    If Err.Number <> 0 Then
        Text1.Text = "文件a.xlsx已打開"
    Else
        Text1.Text = "文件a.xlsx已關閉"
        Name "d:\a2.xlsx" As "d:\a.xlsx"
    End If
End Sub

VB判斷鼠標是否在窗體外最簡單的代碼

Private Declare Function GetActiveWindow Lib "user32" () As Long
Private Sub Form_Load()
    Timer1.Interval = 100
End Sub
Private Sub Timer1_Timer()
    If GetActiveWindow() = Me.Hwnd Then
        Me.Caption = "在"
    Else
        Me.Caption = "不在"
    End If
End Sub

---

本文為蝌索窩網(科杰在線)pc354.com原創文章，歡迎轉載，但請標明出處，謝謝

標題：vb6(visual basic)常用代碼及說明收集 鏈接：http://pc354.com/blog/Article.asp?443.html

---