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

---