1. 求一个很多空文件夹,打开到最后是桌面开满玫瑰花的小程序
这个你自己 做一个好了,
比如你建立一个文件夹,在里面再建立一个…………,依次建立,然后下个开满玫瑰花的程序,把程序的图标换成文件夹的,这样人家以为还是文件夹
改ico的软件也很多, 不知道怎么做的可以联系我哦!
2. 我有一个“可执行程序”(EXE)的文件,一打开,电脑屏幕上就会出现很多玫瑰花,请问这是怎么做到的
用VB
源程序如下:
Option Explicit
Dim s As Integer
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 GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex 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
Const LWA_COLORKEY_ALPHA As Long = &H3
Const WS_EX_LAYERED As Long = &H80000
Const GWL_EXSTYLE As Long = (-20)
Private RawWidth As Long '保存窗体的原始宽度
Private RawHeight As Long '保存窗体的原始高度
Private RawFont As Single '保存窗体的原始字体比
Private Sub Form_Resize()
Call ResizeForm(Me) '调用窗体改变时控件随之改变
End Sub
Private Sub Form_Load()
Call ResizeInit(Me) '在程序载入时必须加入,否则不能随之改变
Timer1.Enabled = True
WindowsMediaPlayer1.URL = App.Path & "\" & "8.mp3"
End Sub
'在调用ResizeForm前先调用本函数
Public Sub ResizeInit(FormName As Form)
On Error Resume Next
Dim Obj As Control
RawWidth = FormName.ScaleWidth
RawHeight = FormName.ScaleHeight
RawFont = FormName.Font.Size / RawHeight
For Each Obj In FormName
Obj.Tag = Obj.Left & " " & Obj.Top & " " & Obj.Width & " " & Obj.Height & " "
Next Obj
End Sub
'按比例改变表单内各元件的大小,
'在调用ReSizeForm前先调用ReSizeInit函数
Public Sub ResizeForm(FormName As Form)
On Error Resume Next
Dim Pos(4) As Double
Dim i As Long, TempPos As Long, StartPos As Long
Dim Obj As Control
Dim ScaleX As Double, ScaleY As Double
ScaleX = FormName.ScaleWidth / RawWidth
'保存窗体宽度缩放比例
ScaleY = FormName.ScaleHeight / RawHeight
'保存窗体高度缩放比例
For Each Obj In FormName
StartPos = 1
For i = 0 To 4
'读取控件的原始位置与大小
TempPos = InStr(StartPos, Obj.Tag, " ", vbTextCompare)
If TempPos > 0 Then
Pos(i) = Mid(Obj.Tag, StartPos, TempPos - StartPos)
StartPos = TempPos + 1
Else
Pos(i) = 0
End If
'根据控件的原始位置及窗体改变大
'小的比例对控件重新定位与改变大小
Obj.Move Pos(0) * ScaleX, Pos(1) * ScaleY, Pos(2) * ScaleX, Pos(3) * ScaleY
Obj.Font.Size = RawFont * FormName.ScaleHeight
Next i
Next Obj
End Sub
'把以上添加到模块中
Private Sub Command1_Click()
Unload Me
End Sub
Private Sub Timer1_Timer()
s = s + 1
If s = 1 Then
Picture1.Visible = True
ElseIf s = 2 Then
Picture2.Visible = True
ElseIf s = 3 Then
。。。。。。
End If
End Sub
省略号那里 你自己看添加的图片数量 自己添加是了 相信你能看懂吧
补充: Option Explicit
Dim s As Integer
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 GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex 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
Const LWA_COLORKEY_ALPHA As Long = &H3
Const WS_EX_LAYERED As Long = &H80000
Const GWL_EXSTYLE As Long = (-20)
Private RawWidth As Long '保存窗体的原始宽度
Private RawHeight As Long '保存窗体的原始高度
Private RawFont As Single '保存窗体的原始字体比
Private Sub Form_Resize()
Call ResizeForm(Me) '调用窗体改变时控件随之改变
End Sub
Private Sub Form_Load()
Call ResizeInit(Me) '在程序载入时必须加入,否则不能随之改变
Timer1.Enabled = True
WindowsMediaPlayer1.URL = App.Path & "\" & "8.mp3"
End Sub
'在调用ResizeForm前先调用本函数
Public Sub ResizeInit(FormName As Form)
On Error Resume Next
Dim Obj As Control
RawWidth = FormName.ScaleWidth
RawHeight = FormName.ScaleHeight
RawFont = FormName.Font.Size / RawHeight
For Each Obj In FormName
Obj.Tag = Obj.Left & " " & Obj.Top & " " & Obj.Width & " " & Obj.Height & " "
Next Obj
End Sub
'按比例改变表单内各元件的大小,
'在调用ReSizeForm前先调用ReSizeInit函数
Public Sub ResizeForm(FormName As Form)
On Error Resume Next
Dim Pos(4) As Double
Dim i As Long, TempPos As Long, StartPos As Long
Dim Obj As Control
Dim ScaleX As Double, ScaleY As Double
ScaleX = FormName.ScaleWidth / RawWidth
'保存窗体宽度缩放比例
ScaleY = FormName.ScaleHeight / RawHeight
'保存窗体高度缩放比例
For Each Obj In FormName
StartPos = 1
For i = 0 To 4
'读取控件的原始位置与大小
TempPos = InStr(StartPos, Obj.Tag, " ", vbTextCompare)
If TempPos > 0 Then
Pos(i) = Mid(Obj.Tag, StartPos, TempPos - StartPos)
StartPos = TempPos + 1
Else
Pos(i) = 0
End If
'根据控件的原始位置及窗体改变大
'小的比例对控件重新定位与改变大小
Obj.Move Pos(0) * ScaleX, Pos(1) * ScaleY, Pos(2) * ScaleX, Pos(3) * ScaleY
Obj.Font.Size = RawFont * FormName.ScaleHeight
Next i
Next Obj
End Sub
'把以上添加到模块中
Private Sub Command1_Click()
Unload Me
End Sub
Private Sub Timer1_Timer()
s = s + 1
If s = 1 Then
Picture1.Visible = True
ElseIf s = 2 Then
Picture2.Visible = True
ElseIf s = 3 Then
。。。。。。
End If
End Sub
那些玫瑰 自己添加在窗体上
省略号那里 你自己看添加的图片数量 自己添加是了
3. 求电脑小程序——1、一个文件夹,名为“礼物”,点开后会出现很多玫瑰花。2、点击后可以在桌面下雪
第一个礼物我有~
希望采纳