当前位置:编程学习 > VB >>

要一個祝朋友生日快樂的VB小程序。

要一個祝朋友生日快樂的VB小程序。 要能让桌面出现蛋糕,然后会放音乐的。还要让桌面出现祝福语。
补充:烦请发到我QQ邮箱339717139@qq.com

追问:请问你把运行程序发给我了吗?

答案:本程序是一个生日祝福小程序,程序运行后,弹出一个对话框:“送你6束鲜花,祝你生日快乐”,用户不论单击“确定”还是“取消”,程序都不会停止。
  随后,各种各样的鲜花和一条祝福语从屏幕上方飘荡而下,直到飘出屏幕底部才消失。设定的鲜花数(本程序默认设定为6束)全部显示完后,程序自动终止。
  鲜花和祝福语是显示在任何程序前面的,可在任何窗口上飘荡,包括任务栏、开始菜单、弹出菜单等地方。程序每次运行显示的鲜花图片是随机的,显示图像采用了绘图的方式,不使用移动 Image 等控件的方式,那样屏幕容易产生闪烁。
  根据自己的喜好,可修改标注有“'****”的语句,设定下面参数:
    祝福语 默认为:祝你生日快乐
    同时显示的图片数 默认为:3
    显示几幅图片后自动终止程序 默认为:6
    鲜花图片文件路径 默认为:C:\MyPic
  当然,应在设定的“图片文件路径”所在文件夹中放置一些鲜花图片文件,如果没有图片文件,或文件格式错误,就用窗口的图标代替。图片文件数越多,程序运行时随机选择鲜花图像的可能性变化越大。图片文件要使用 gif 或 bmp 等格式的。不能使用 jpg 格式文件,这种格式的图片背景不纯,显示在桌面背景上会有许多杂点。
  我从网上下载了下面两幅 gif 图片放在 C:\MyPic 文件夹中,程序运行效果()见下。
  放在 C:\MyPic 文件夹中的图片文件:
      

   程序运行效果截图:
  ?

''下面是 Form1 窗体代码,在 VB6 调试通过:=====================================
''注意:1.在“C:\MyPic”文件夹中放几个 gif 或 bmp 格式的鲜花图片文件。
''   2.在“工程/引用”中确保勾选了 OLE Automation,否则语句“Pic As StdPicture”会出错。
''   3.在属性窗口将窗体的 BorderStyle 属性设置为 0,即窗体是无边框窗体。
''   4.在窗体上放置三个控件:Timer1,Picture1,File1,不必设置任何属性。
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
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 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 GdiTransparentBlt Lib "gdi32" (ByVal hdc1 As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal W1 As Long, ByVal H1 As Long, ByVal Hdc2 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal W2 As Long, ByVal H2 As Long, ByVal Color As Long) As Long

Dim ctPic() As tyPic, ctPicS As Long, ctStr As String, ctS As Long
Private Type tyPic '定义表示图片的数据类型
   X As Single: xV As Single            'x 坐标、水平移动速度
   Y As Single: yV As Single            'y 坐标、垂直移动速度
   Pic As StdPicture: BackColor As Long '图像、透明背景色
   H As Long: W As Long                 '图像高度和宽度
End Type

Private Sub Form_Load()
   Me.Caption = "生日快乐"
   ctStr = "祝你生日快乐" '**** 祝福语
   ctPicS = 3            '**** 同时显示的图片数
   ctS = 6               '**** 显示几幅图片后自动终止程序
   
   MsgBox "送你 " & ctS & " 束鲜花" & vbCrLf & vbCrLf & ctStr, vbInformation + vbOKCancel, "祝福你"
   
   On Error Resume Next
   File1.Path = "C:\MyPic" ' App.Path '**** 指定鲜花图片文件路径
   File1.Pattern = "*.gif;*.bmp"
   File1.Visible = False
   On Error GoTo 0
   
   Me.WindowState = 0: Me.ScaleMode = 3
   Me.AutoRedraw = True: Me.BackColor = RGB(220, 220, 220)
   Me.Move 0, 0, Screen.Width, Screen.Height
   
   Picture1.BorderStyle = 0: Picture1.AutoRedraw = True
   Picture1.AutoSize = True: Picture1.Visible = False
   Picture1.ScaleMode = 3: Picture1.BackColor = Me.BackColor
   Picture1.Font.Size = 48: Picture1.Font.Bold = True

   ReDim ctPic(0 To ctPicS)
   Call TransWin(Me.hWnd, Me.BackColor) '将窗口背景色设置为透明的
   Timer1.Enabled = True: Timer1.Interval = 30
End Sub

Private Sub Timer1_Timer()
   Dim I As Long, V As Single, IsHas As Boolean
   
   V = 8                    '修改此数字,可改变图片整体飘荡的速度
   WinInTop Me.hWnd, True   '使图片(窗口)显示在最前,包括显示到任务栏上面
   Me.Line (0, 0)-(Me.ScaleWidth, Me.ScaleHeight), Me.BackColor, BF
   
   For I = ctPicS To 0 Step -1
      ctPic(I).X = ctPic(I).X + ctPic(I).xV * V
      ctPic(I).Y = ctPic(I).Y + ctPic(I).yV * V
      Randomize                '初始化随机发生器
      If Rnd * 20 < 1 Then ctPic(I).xV = Rnd - 0.5 '改变水平移动速度,模拟随风飘荡
      If ctPic(I).X < 0 Then ctPic(I).X = 0        '超出左边界
      If ctPic(I).X > Me.ScaleWidth - ctPic(I).W Then ctPic(I).X = Me.ScaleWidth - ctPic(I).W '超出右边界
      
      If ctPic(I).Y > Me.ScaleHeight Or ctPic(I).W = 0 Then '未初始化,或超出下边界
         If ctS > 0 Then
            Call Init(I) '初始化图片
            If I > 0 Then ctS = ctS - 1
         Else
            ctPic(I).Y = Me.ScaleHeight + 1: ctPic(I).W = 0
         End If
      End If
      
      If ctPic(I).Y < Me.ScaleHeight Then IsHas = True: DrawImg Me, I '绘制图像
   Next
   If Not IsHas Then Unload Me '指定图片数已显示完毕,自动终止程序
End Sub

Private Sub DrawImg(Kj, I As Long)
   '将数组 ctPic() 的第 I 个图像绘制到 Kj,不复制背景色
   Dim W As Long, H As Long, X As Long, Y As Long
   
   Picture1.Picture = ctPic(I).Pic '将图像显示到临时图片框 Picture1
   X = ctPic(I).X: Y = ctPic(I).Y
   W = ctPic(I).W: H = ctPic(I).H
   
   '将图像绘制到目标对象 Kj,通过 GdiTransparentBlt 的最后一个参数指定透明色
   GdiTransparentBlt Kj.hDC, X, Y, W, H, Picture1.hDC, 0, 0, W, H, ctPic(I).BackColor
End Sub

Private Sub Init(I As Long)
   '初始化图片
&nbs

上一个:vb中setfocus lostfocus gotfocus之间有什么关系和区别
下一个:一个新手 学习C语言好还是VB语言好。

CopyRight © 2012 站长网 编程知识问答 www.zzzyk.com All Rights Reserved
部份技术文章来自网络,