用VB制作小程序

用VB制作小程序,第1张

Option Explicit

Private Sub Form_Load()

    Randomize

    Label1Caption = Int((Rnd  (999999 - 100000 + 1)) + 100000)    '生成100000-999999之间的随机数

    Timer1Interval = 1000  '一秒一次

    Timer1Enabled = True

End Sub

Private Sub Timer1_Timer()

    Static n As Integer

    n = n + 1

    If n = 60 Then      '一秒一次,累加到60此即60秒

        n = 0

        Randomize

        Label1Caption = Int((Rnd  (999999 - 100000 + 1)) + 100000)

    End If

End Sub

有问题请追问,,加油!

用VB做万年历,非常关键点就是农历写法,参考代码如下:

#Region " 返回农历 "

'返回农历

'cCalendarMaxSupportedDateTime 返回支持的最大日期,即2101-1-28

'cCalendarMinSupportedDateTime 返回支持的最小日期,即190-2-19

Private cCalendar As New SystemGlobalizationChineseLunisolarCalendar

Public Function PubFunGet_CNDate(ByVal sDateTime As Date) As String

cCalendar = New SystemGlobalizationChineseLunisolarCalendar

Dim lyear As Integer = cCalendarGetYear(sDateTime)

Dim lmonth As Integer = cCalendarGetMonth(sDateTime)

Dim lday As Integer = cCalendarGetDayOfMonth(sDateTime)

Dim lweek As Integer = cCalendarGetDayOfWeek(sDateTime)

'获取闰月, 0 则表示没有闰月

Dim leapMonth As Integer = cCalendarGetLeapMonth(lyear)

Dim isleap As Boolean = False

If (leapMonth > 0) Then

If (leapMonth = lmonth) Then

'闰月

isleap = True

lmonth = lmonth - 1

ElseIf (lmonth > leapMonth) Then

lmonth = lmonth - 1

End If

End If

Return StringConcat(GetLunisolarYear(lyear), IIf(isleap = True, "闰年", "年"), GetLunisolarMonth(lmonth), "月", GetLunisolarDay(lday))

End Function

'十天干

Private tiangan As String() = {"甲", "乙", "丙", "丁", "戊", "己", "庚", "辛", "壬", "癸"}

'十二地支

Private dizhi As String() = {"子", "丑", "寅", "卯", "辰", "巳", "午", "未", "申", "酉", "戌", "亥"}

'十二生肖

Private shengxiao As String() = {"鼠", "牛", "虎", "免", "龙", "蛇", "马", "羊", "猴", "鸡", "狗", "猪"}

'农历月

Private months As String() = {"正", "二", "三", "四", "五", "六", "七", "八", "九", "十", "十一", "十二(腊)"}

'农历日

Private days1 As String() = {"初", "十", "廿", "三"}

Private days As String() = {"一", "二", "三", "四", "五", "六", "七", "八", "九", "十"}

'返回农历年(天干 地支 生肖)

Private Function GetLunisolarYear(ByVal year As Integer) As String

GetLunisolarYear = ""

If (year > 3) Then

Dim tgIndex As Integer = (year - 4) Mod 10

Dim dzIndex As Integer = (year - 4) Mod 12

Return tiangan(tgIndex) & dizhi(dzIndex) & "[" & shengxiao(dzIndex) & "]"

End If

'无效的年份!

End Function

'返回生肖

Private Function GetShengXiao(ByVal sDateTime As Date) As String

Return shengxiao(cCalendarGetTerrestrialBranch(cCalendarGetSexagenaryYear(sDateTime)) - 1)

End Function

'返回农历月

Private Function GetLunisolarMonth(ByVal month As Integer) As String

GetLunisolarMonth = ""

If (month < 13 AndAlso month > 0) Then

Return months(month - 1)

End If

'无效的月份!

End Function

'返回农历日

Private Function GetLunisolarDay(ByVal day As Integer) As String

GetLunisolarDay = ""

If (day > 0 AndAlso day < 32) Then

If (day <> 20 AndAlso day <> 30) Then

Return StringConcat(days1((day - 1) \ 10), days((day - 1) Mod 10))

Else

Return StringConcat(days((day - 1) \ 10), days1(1))

End If

End If

'无效的日!

End Function

#End Region

试试这个吧

Private Sub Command1_Click()

Dim Link As String

Dim objURL

Text2 = ""

Link = "<a href=" & Chr(34) & "URL" & Chr(34) & ">" & "网名" & "</a>"

For Each objURL In Split(Trim(Text1), vbCrLf)

If objURL <> "" Then Text2 = Text2 & Replace(Replace(Link, "URL", Right(objURL, Len(objURL) - 3)), "网名", Left(objURL, 2)) & vbCrLf

Next

End Sub

楼主您好!

代码如下:

Option Explicit

Private Sub Command1_Click()

    Dim n(7) As Double

    Dim k(3) As Double

    k(3) = 1

    Dim j As Integer

    For j = 1 To 7

        n(j) = Val(Controls("Text" & CStr(j))Text)

    Next j

    For j = 1 To 7

        k(1) = k(1) + n(j)

        k(2) = k(2) - n(j)

        k(3) = k(3)  n(j)

    Next j

    MeText8Text = "7个数的和为:" & k(1) & vbCrLf & _

                    "7个数的差为:" & k(2) & vbCrLf & _

                    "7个数的乘积为:" & k(3)

End Sub

Private Sub Command2_Click()

    Dim i As Integer

    For i = 1 To 8

        Controls("Text" & CStr(i))Text = ""

    Next i

End Sub

Private Sub Form_Load()

    Dim i As Integer

    For i = 1 To 8

        Controls("Text" & CStr(i))Text = ""

    Next i

End Sub

其实不用Hook,也不用模块,检查系统闲置时间已有专用函数,不必这么复杂。

完整代码如下:

Option Explicit

Private Declare Function GetLastInputInfo Lib "user32" (plii As LASTINPUTINFO) As Boolean

Private Declare Function GetTickCount Lib "kernel32" () As Long

Private Type LASTINPUTINFO

cbSize As Long

dwTime As Long

End Type

Dim lii As LASTINPUTINFO

Private Sub Form_Load()

Timer1Interval = 1000

liicbSize = Len(lii)

End Sub

Private Sub Timer1_Timer()

If GetLastInputInfo(lii) Then

If (GetTickCount - liidwTime) / 60000 >= 15 Then

Shell "shutdownexe -s -t 180"

Call MsgBox("由于本机15分钟没有 *** 作,如果3分钟后没有反应,系统将强制关机", vbYesNo + vbExclamation + vbDefaultButton2, "提示")

End If

End If

End Sub

Private Sub form_click()

MeShow

m = 10

n = 1

Print Int(Rnd (m - n - 1) + n + 1)

End Sub

第二题

Private Sub Form_Load()

Timer1Enabled = True

Timer1Interval = 1000

End Sub

Private Sub Timer1_Timer()

Cls

Print Format(Now, "long date") & " " & Time

End Sub

代码改为:Private Sub Form_Click()Dim a, b, c, d As StringDim sum, aver As Longa = Val(InputBox("请输入第一个数"))

b = InputBox("请输入第二个数")

c = InputBox("请输入第三个数")

d = InputBox("请输入第四个数")

sum = a + b + c + d

aver = sum / 4

Print "所输入的4个数字分别是"; a, b, c, d

Print "4个数字的和为"; sum

Print "4个数字的平均值为"; averEnd Sub VB60下调试通过。

'用法:: AA "1234"

Function AA(ByVal x As String) As String

Dim ns As Integer

ns = Len(x)

Dim n() As String

Dim w() As Integer

ReDim n(ns)

ReDim w(ns)

Dim i As Integer

For i = 1 To ns

n(i) = Mid(x, ns - i + 1, 1)

Next

Dim str As String

BB n, w, 0, str

MsgBox str

Open "c:\1txt" For Output As #1 ''输出文件句自己改

Print #1, str

Close #1

End Function

Function BB(ByRef n() As String, w() As Integer, ByVal k As Integer, s As String)

Dim i As Integer, j As Integer

Dim b As Boolean

For i = 1 To UBound(n)

b = False

For j = 1 To k

If i = w(j) Then

b = True

Exit For

End If

Next

If Not b And k + 1 <= UBound(n) Then

w(k + 1) = i

BB n, w, k + 1, s

End If

Next

If UBound(w) = k Then

For i = 1 To UBound(w)

s = s & n(w(i))

Next

s = s & vbCrLf

Exit Function

End If

End Function

以上就是关于用VB制作小程序全部的内容,包括:用VB制作小程序、用vb编写万年历小程序、用vb如何做这个生成链接的小程序等相关内容解答,如果想了解更多相关内容,可以关注我们,你们的支持是我们更新的动力!

欢迎分享,转载请注明来源:内存溢出

原文地址:https://www.54852.com/zz/9301886.html

(0)
打赏 微信扫一扫微信扫一扫 支付宝扫一扫支付宝扫一扫
上一篇 2023-04-26
下一篇2023-04-26

发表评论

登录后才能评论

评论列表(0条)

    保存