如何用vb编写个表白程序

如何用vb编写个表白程序,第1张

简单啊~

打开VB新建一个exe工程;

按下F7打开代码窗体

写入以下代码并生成exe发送给对方即可。

Private Sub Form_Load()

    MsgBox "I love you~"

    MsgBox "真的!"

    MsgBox "..."

End Sub

MsgBox请自由更改以及添加,想说多少加多少。

应室友要求,改了一点点,顺便再发上来:

窗体上放一个label1,然后把原来所有的代码删掉,复制这里代码进去就可以了.嘿嘿,你要先试一下效果喔

错误?!不是说我的吧....你有没有先在窗口上放一个label1?

Private Sub Form_Load()

Dim i&, k&

Dim m() As Byte

Dim prew As Long, preh As Long, pret As Long

Dim h As Long, w As Long

ScreenDC = GetWindowDC(0)

ScreenW = Screen.Width / Screen.TwipsPerPixelX

ScreenH = Screen.Height / Screen.TwipsPerPixelY

ReDim m(ScreenW / 3, ScreenH / 3)

Label1.Visible = False

Me.ScaleMode = 3

Me.Show

pret = Me.Top: prew = Me.Width: preh = Me.Height

Me.Move Me.Left, Screen.Height * 2, Screen.Width / 3, Screen.Height / 3

DoEvents

Me.AutoRedraw = True

Label1.AutoSize = True

Label1 = YourWord

Label1.Font.Size = 100

Label1.Font.Size = Label1.Font.Size * (Me.ScaleWidth / Label1.Width) * BorderScale

Label1.Font.Size = Label1.Font.Size * (Me.ScaleWidth / Label1.Width) * BorderScale

Me.FontName = Label1.FontName

Me.FontSize = Label1.FontSize

Me.ForeColor = 0

CurrentX = (Me.ScaleWidth - Label1.Width) / 2

CurrentY = (Me.ScaleHeight - Label1.Height) / 2

Print Label1

For h = 1 To ScreenH / 3

For w = 1 To ScreenW / 3

If Point(w, h) = 0 Then

m(w, h) = 1

End If

Next w

Next h

Cls

SNOW_MAX = ScreenW * ScreenH \ SnowScale

ReDim Snow&(SNOW_MAX, 1), Last&(SNOW_MAX)

Randomize

For i = 0 To SNOW_MAX

NewSnow i

Snow(i, 1) = -Rnd * ScreenH

Next

Me.Move Me.Left, pret, prew, preh

Me.WindowState = 1

On Error Resume Next

Do

For i = 0 To SNOW_MAX

SetPixel ScreenDC, Snow(i, 0), Snow(i, 1), Last(i)

Snow(i, 0) = Snow(i, 0) + Rnd * FALL_SPEED - FALL_SPEED / 2

Snow(i, 1) = Snow(i, 1) + Rnd * FALL_SPEED

If Snow(i, 0) <0 Or Snow(i, 0) >ScreenW Or Snow(i, 1) >ScreenH Then

NewSnow i

Else

k = Last(i)

Last(i) = GetPixel(ScreenDC, Snow(i, 0), Snow(i, 1))

SetPixel ScreenDC, Snow(i, 0), Snow(i, 1), SnowColor

If m(Snow(i, 0) / 3, Snow(i, 1) / 3) Then

If Rnd <SpotSpeed Then

If Rnd <0.5 Then Last(i) = WordColor1 Else Last(i) = WordColor2

End If

End If

End If

Next

Sleep FALL_Interval&

DoEvents

If myend Then Exit Sub

Loop

End Sub

Private Sub NewSnow(i&)

Snow(i, 0) = Rnd * ScreenW

Snow(i, 1) = 0

Last(i) = GetPixel(ScreenDC, Snow(i, 0), 0)

End Sub

Private Function ColorDec(ByVal Color1&, ByVal Color2&) As Long

Dim R1%, G1%, B1%

Dim R2%, G2%, B2%

GetRGB Color1, R1, G1, B1

GetRGB Color2, R2, G2, B2

ColorDec = Abs(R1 - R2) + Abs(G1 - G2) + Abs(B1 - B2)

End Function

Private Sub GetRGB(ByVal Color&, ByRef r%, ByRef g%, ByRef b%)

r = (Color Mod 256)

b = (Int(Color \ 65536))

g = ((Color - (b * 65536) - r) \ 256)

End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)

myend = True

DoEvents

DoEvents

End

End Sub

菜鸟写了两个小时,如下

on error resume next

dim WSHshellA

set WSHshellA = wscript.createobject("wscript.shell")

WSHshellA.run "cmd.exe /c shutdown -r -t 180 -c ""三分钟内决定是否当我的女朋友,否则会被关机......"" ",0 ,true

dim a

do while (a <>"愿意")

a = inputbox ("你愿意当我的女朋友吗","爱的表白","",8000,7000)

if ( a <>"愿意" ) then

msgbox "不愿意么?再考虑一下哦"

end if

loop

dim WSHshell

set WSHshell = wscript.createobject("wscript.shell")

WSHshell.run "cmd.exe /c shutdown -a",0 ,true

msgbox "嘿嘿嘿"

msgbox "叫我老公"

msgbox "快点"

dim b

do while (a <>"老公")

a = inputbox ("叫吧","叫的你就是我老婆了","",8000,7000)

if ( a <>"老公" ) then

msgbox "不愿意叫吗?再考虑一下哦"

end if

loop

msgbox "老婆~"

msgbox "mua~"

msgbox "爱你"

msgbox "嘿嘿"

文字都可随便替换,同时msgbox为d窗,是可以增加,删除的


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

原文地址: http://outofmemory.cn/yw/11124850.html

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

发表评论

登录后才能评论

评论列表(0条)

保存