-

Visual Basic下载安装使用教程（图文教程）

VB6.0是一种由微软公司开发的包含协助开发环境的事件驱动编程语言。VB6.0源自于BASIC编程语言。

Visual Basic下载

Microsoft Visual Basic 6.0 是在过去广泛使用的一个版本，但它目前不再被推荐使用，因为它不兼容现代操作系统和最新的开发环境。微软推荐使用更新的 Visual Basic 版本，如 Visual Basic .NET，或其他更适合的编程语言和工具。
在搜索引擎里搜索下载

Visual Basic安装

双击 >> VSCodeUserSetup-x64-1.78.2.exe >> 一直选择Next >> OK

部件和控件安装

RichTextBox 控件是一个用于显示和编辑富文本的文本框控件。RichTextBox 控件允许你在文本中使用不同的字体、颜色、样式和格式。

WebBrowser 控件是一个嵌入式的浏览器控件，可以用来显示网页内容。下面介绍一些 WebBrowser 控件的基本属性和简单使用技巧方法。 属性：
Name: 控件的名称，用于在代码中引用控件。 Visible: 控件的可见性。 Top, Left, Width, Height: 控件的位置和大小。 Navigate: 用于加载指定的网页。 Document: 用于访问当前加载的网页的文档对象。 URL: 当前加载网页的 URL。 ReadyState: 表示当前网页的加载状态。 常用方法： Navigate(url): 加载指定的网页。 GoBack: 返回上一个页面。 GoForward: 前进到下一个页面。 Refresh: 刷新当前页面。 Stop: 停止加载当前页面。
mscomctl.ocx 是一个常见的 Windows 控件文件，用于支持 Microsoft Common Controls（Microsoft 公共控件）库中的图形用户界面元素。它包含了多个常用控件，如树形视图、列表视图、进度条、按钮等，可以用于创建丰富和交互性强的 Windows 程序界面。

配置

设置启动窗体

使用

使用和创建窗体

创建vb6项目
添加MDI窗体，MDI窗体一个项目里只能创建一个

修改启动对象
设置MID窗体里菜单
全屏显示MID窗体里,并设置默认打开一个子窗体，WindowState=2-Maximized
设置Form1子窗体在MID窗体里全屏打开，WindowState=2-Maximized，MDIChild=True
创建和导入模块
引入 Microsoft ActiveX Data Objects 2.5 Library 来操作数据库
读数据库里指定表，并显示总条数
部件 Microsoft Windows Common Controls6.0 列表
ListView 组件使用

VB6 里使用 xiyueta.js

在 vb6 里调用 xiyueta.js库，使用 asp.xiyueta.min.js 文件
下载vb里运行xiyuetajs源码>>

vb6里使用代码： 
Dim Sc


'加载
Private Sub Form_Load()
    Set Sc = CreateObject("ScriptControl")
    Sc.language = "Jscript" '设置语言为javascript
    Sc.Timeout = -1
    Sc.AddCode getFText("asp.xiyueta.min.js")
    Sc.AddCode getFText("1.js")
    
    txtHtml.Text = "<div style='color:red'>aaa</div><div>bbb</div><div>ccc</div>"
    txtMsg.Text = ""
    txtAction.Text = "xiyueta('div').html()"
    
    '两种调用方法
    'Sc.Run("mytestfun", html)
    'Sc.Eval(" xiyueta.load('" & html & "');xiyueta('div').text()")
End Sub
'加载html
Private Sub Command1_Click()
    Call Sc.Run("load", txtHtml.Text)
End Sub
'运行动作
Private Sub Command2_Click()
    On Error Resume Next
    Dim s
    s = Sc.eval(txtAction.Text)
    txtMsg.Text = s
    If Err Then MsgBox ("出错")
End Sub
'循环每项
Private Sub Command3_Click()
    On Error Resume Next
    Dim nCount, i, s, c
    nCount = Sc.eval("xiyueta('div').length")
    For i = 0 To nCount
        s = Sc.eval("xiyueta('div:eq(" & i & ")').htmlwrap()")
        c = c & s & vbCrLf
    Next
    txtMsg.Text = c
    If Err Then MsgBox ("出错")
End Sub

'读文件内容
Function getFText(filePath)
    Dim fso, fText, openFile
    filePath = handlePath(filePath)                                                      '获得完整路径
    Set fso = CreateObject("Scripting.FileSystemObject")
        If fso.fileExists(filePath) = True Then
            Set fText = fso.openTextFile(filePath, 1)
                '加强 读空文件出错
                Set openFile = fso.getFile(filePath)
                    If openFile.Size = 0 Then getFileText = "": Exit Function                       '文件为空则退出
                Set openFile = Nothing
                getFText = fText.readAll
                 
            Set fText = Nothing
        End If
    Set fso = Nothing
End Function
 

Function handleSystemPath(fFPath)
    If InStr(fFPath, ":") = 0 Then
        If Left(fFPath, 1) = "\" Then
            fFPath = App.Path & "\" & "\" & fFPath
        Else
            fFPath = App.Path & ".\" & "\" & fFPath
        End If
    End If
    handleSystemPath = fFPath
End Function
'处理成完成路径 (2013,9,27
Function handlePath(fFPath)                                                     'Path前面不加ByVal 重定义，这样是为了让前面函数里可以使用这个路径完整调用
    fFPath = Replace(fFPath, "/", "\")
    fFPath = Replace(fFPath, "\\", "\")
    fFPath = Replace(fFPath, "\\", "\")
    Dim isDir                                                                       '为目录
    isDir = False
    If Right(fFPath, 1) = "\" Then
        isDir = True
    End If
    If InStr(fFPath, ":") = 0 Then
        If Left(fFPath, 1) = "\" Then
            fFPath = handleSystemPath("\") & "\" & fFPath
        Else
            fFPath = handleSystemPath(".\") & "\" & fFPath
        End If
    End If
    fFPath = Replace(fFPath, "/", "\")
    fFPath = Replace(fFPath, "\\", "\")
    fFPath = Replace(fFPath, "\\", "\")
    fFPath = fullPath(fFPath)
    If isDir = True Then
        fFPath = fFPath & "\"
    End If
    handlePath = fFPath
End Function
'完整路径
Function fullPath(ByVal fFPath)
    Dim splStr, s, c
    c = ""
    fFPath = Replace(fFPath, "/", "\")
    splStr = Split(fFPath, "\")
    For Each s In splStr
        s = Trim(s)
        If s <> "" And s <> "." Then
            If InStr(c, "\") > 0 And s = ".." Then
                c = Mid(c, 1, InStrRev(c, "\") - 1)
            Else
                If c <> "" And Right(c, 1) <> "\" Then c = c & "\"
                c = c & s
            End If
        End If
    Next
    fullPath = c
End Function
'处理成相对路径(20150906)  如 a=handleRelativePath("",a)
Function handleRelativePath(rootPath, ByVal filePath)
    If rootPath = "" Then rootPath = "\"
    rootPath = handlePath(rootPath)
    filePath = Replace(filePath, rootPath, "\")
    handleRelativePath = filePath
End Function
1.js文件代码： 
//加载Html源码
function load(c){ 
    xiyueta.load(c)
}
vb6里创建dll和使用dll

在 vb6 里 创建dll文件，并注册这个dll，然后在vb6里使用这个dll的全过程
还在asp网站里使用 下载dll及案例源码>>

vb6项目里创建dll工程
创建ClassXiyueta类
工程属性>>名称改成 XiyetaDll
文件 >> 生成XiyetaDll文件
Regsvr32 D:\vb\vbDLL\dll\XiyuetaDll.dll 注册dll(以管理员权限)
Regsvr32 /u D:\vb\vbDLL\dll\XiyuetaDll.dll 卸载dll(以管理员权限)
vb6工程里引用dll
代码为： MsgBox (XiyuetaDll.ClassXiyueta.AddNumbers(6, 2))
asp网站里引用和使用XiyuetaDll

ASP里代码： 
<%
    Dim myObj
    Set myObj = Server.CreateObject("XiyuetaDll.ClassXiyueta")
 
    Dim result
    result = myObj.AddNumbers(1, 5)

    response.write("result=" & result)
%>
vb6里创建dll和使用dll

在 vb6 里 创建dll文件，并注册这个dll，然后在vb6里使用这个dll的全过程
还在asp网站里使用 下载颜色取色器>>

颜色取色器

ASP里代码： 



Dim P As POINTAPI
Public HTXT                        '文本

 

'加载
Private Sub Form_Load()
End Sub
'按下
Private Sub lblSelColor_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    lblSelColor.MousePointer = 99
End Sub
'移动
Private Sub lblSelColor_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    Dim Ros As Long, StrHex, RTemp
    If Button = 1 Then
        RGBOption = False
        GetCursorPos P
        d = GetDC(0)
        Ros = GetPixel(d, P.x, P.y)
        lblSelColor.BackColor = Ros
        txtColor.Text = toHexColor(Ros)
        
        StrHex = Replace(txtColor.Text, "&H", "")
        R.Value = CHex(Right$(StrHex, 2))  '右边
        G.Value = CHex(Right$(Left$(StrHex, 4), 2))  '中间
        B.Value = CHex(Left$(StrHex, 2))  '左边
        
        
        txtColor.Text = Replace(txtColor.Text, "&H", "#")
        txtColor.Text = ColorZWHandle(txtColor.Text)
        
        
    End If
End Sub
' 颜色错位处理,20111027，以后待再完善
Function ColorZWHandle(ByVal content)
    Dim C, S
    C = content
    S = "#"
    S = S & Mid(C, 6, 1) & Mid(C, 7, 1)
    S = S & Mid(C, 4, 1) & Mid(C, 5, 1)
    S = S & Mid(C, 2, 1) & Mid(C, 3, 1)
    '#F16504
    ColorZWHandle = S
End Function
' 释放
Private Sub lblSelColor_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Button = 1 Then
        RGBOption = True
    End If
End Sub
' 选择系统颜色
Private Sub cmdSystemColor_Click()
    Dim color As Long, StrHex
    FrmHide.CommonDialog1.CancelError = True
    On Error GoTo A
    FrmHide.CommonDialog1.ShowColor
    color = FrmHide.CommonDialog1.color
    lblSelColor.BackColor = color
    txtColor.Text = Replace(toHexColor(color), "&H", "#")
    RGBOption = False       ' 颜色选择关系
    StrHex = Replace(txtColor.Text, "&H", "")
    B.Value = CHex(Left$(StrHex, 2))  '左边
    G.Value = CHex(Right$(Left$(StrHex, 4), 2))  '中间
    R.Value = CHex(Right$(StrHex, 2))  '右边
    RGBOption = True        ' 颜色选择开启
    
A:
End Sub
' R红色选择
Private Sub R_Change()
    Call ViewSelectBg
End Sub
' G绿色选择
Private Sub G_Change()
    Call ViewSelectBg
End Sub
' B蓝色选择
Private Sub B_Change()
    Call ViewSelectBg
End Sub
' 显示选择背景颜色
Function ViewSelectBg()
    lblSelColor.BackColor = RGB(R, G, B)
    txtColor.Text = "#" & GetHexColor(R, G, B)
     
End Function
'外部点击应用纯色
Sub ClickCmdUseASolidColor()
    Call CmdUseASolidColor_Click
End Sub
'应用纯色
Private Sub CmdUseASolidColor_Click()
    Dim StrHex
    StrHex = Trim(Replace(txtColor.Text, "#", ""))
    If Len(StrHex) < 4 Then
        Call VBEcho("颜色值不正确，至少有四位字符")
        Exit Sub
    End If
    
    R = CHex(Left(StrHex, 2))                           '左边
    G = CHex(Right(Left(StrHex, 4), 2))                 '中间
    B = CHex(Right(StrHex, 2))                          '右边
    lblSelColor.BackColor = RGB(R, G, B)
    
    '文本改变
    Call txtColor_Change
End Sub
'保存颜色
Private Sub CmdSaveColor_Click()
    If TypeName(HTXT) <> "Empty" Then
       HTXT.Text = txtColor.Text
       Unload Me
    Else
        Call MBInfo("提示", "测试选择颜色，不可保存")
    End If
End Sub
'文本颜色改变
Private Sub txtColor_Change()
    txtMsg.Text = "R=" & R & "G=" & G & "B=" & B
End Sub


'MsgBox回显
Sub MBInfo(title, content)
    MsgBox content, vbInformation, title
End Sub

'底部回显
Function VBEcho(title)
End Function
动态生成按钮

在 vb6 里 动态生成按钮Command，并加上动作
下载动态生成按钮>>

颜色取色器

vb6代码： 
Private WithEvents Command1 As CommandButton
'加载
Private Sub Form_Load()
    Set Command1 = Controls.Add("VB.CommandButton", "btnDynamic")
    With Command1
        .Caption = "动态按钮"
        .Top = 200
        .Left = 200
        .Width = 1500
        .Height = 600
        .Visible = True
    End With
    
    Set Command2 = Controls.Add("VB.CommandButton", "btnDynamic2")
    With Command2
        .Caption = "动态按钮2"
        .Top = 1200
        .Left = 200
        .Width = 1500
        .Height = 600
        .Visible = True
    End With
End Sub

Private Sub Command1_Click()
    MsgBox "动态按钮被点击了！"
End Sub
vb6代码,第二种方法，推荐： 


'加载
Private Sub Form_Load()
    Dim i
    For i = 1 To 10
        Load Command1(i)
        Command1(i).Left = Command1(0).Left
        Command1(i).Top = Command1(i - 1).Top + Command1(0).Height + 50
        Command1(i).Caption = i + 1
        Command1(i).Visible = True
    Next
 

End Sub
'点击按钮组
Private Sub Command1_Click(Index As Integer)
    MsgBox (Command1(Index).Caption)
End Sub
菜单加动态按钮

在 vb6 里 菜单加动态按钮
下载菜单加动态按钮>>

菜单加动态按钮

vb6代码： 
Private Sub Form_Load()
    Load Me.ToolsMenu(1)
    Me.ToolsMenu(1).Caption = "你好"
End Sub

Private Sub ToolsMenu_Click(Index As Integer)
    Dim S, splxx, url, nDJS
    S = ToolsMenu(Index).Caption
    MsgBox (S)
End Sub
网页定时刷新

在 vb6 里 网页定时刷新
下载网页定时刷新>>

网页定时刷新

Copyright © 2023 xiyueta.com MIT Licensed   QQ：313801120   QQ交流群：35915100
免责声明 SiteMap 皖ICP备2021012434号