vb有趣的编程代码表白(vb有意思的代码)
各位大神帮帮忙用VB编一个表白程序，最好能带点惊喜的
这个题 实话说没有难度，只是做个程序，编译成EXE，加入开机运行，就可以了。
可以让玫瑰花一朵朵出现围成一个桃心的VB程序
首先你要准备一个玫瑰花图片文件，要小一点。
然后在窗体上放12个Image控件，组成一个控件数组，摆成心形，Picture属性设置为你的玫瑰花。Visibel属性全部设置为False。
在窗体上放一个Timer控件。Interval属性设置为1000，每秒显示一朵玫瑰花。
OK！你的心愿完成了！
Private Sub Form_Load()
For i = 0 To 11
??? Image1(i).Picture = LoadPicture(App.Path + "\西安绿博园七彩玫瑰.jpg")
Next
Timer1.Enabled = True
End Sub
Private Sub Timer1_Timer()
??? Static i As Integer
??? Image1(i).Visible = True
??? i = i + 1
??? If i = Image1.Count Then
??????? Label1.Visible = True
??????? Timer1.Enabled = False
??? End If
???
End Sub
VBS向女生表白编码万分感谢
菜鸟写了两个小时，如下
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为弹窗，是可以增加，删除的
帮我编一个vb程序 用来表白的
应室友要求,改了一点点,顺便再发上来:
在窗体上放一个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
如何用vb编写个表白程序
简单啊~
打开VB新建一个exe工程；
按下F7打开代码窗体；
写入以下代码并生成exe发送给对方即可。
Private?Sub?Form_Load()
????MsgBox?"I?love?you~"
????MsgBox?"真的！"
????MsgBox?"..."
End?Sub
MsgBox请自由更改以及添加，想说多少加多少。