vb玫瑰花
① 跪求VB6满屏幕玫瑰花开的代码，要详细一点，各种颜色的玫瑰花，最好是可以调的，实在不行，只要是玫瑰花
做了个玫瑰花的，楼主改要花瓣雨了，无语了，做好花瓣雨该改要别的了，要厚道哦
② VB 中玫瑰花数怎么编
当然不会有数字产生了，do
while
d
<=
9这里1000-1009都不满足，验证完后，d=10，自然下次不满足d
<=
9条件就退出了
可以在每次循环结束，重新开始时加个清零操作，或者直接用for语句
③ 在桌面上显示很多玫瑰花的一个vb小程序代码
桌面涂鸦VB程序代码
Option Explicit
Public Type POINTAPI
x As Long
y As Long
End Type
Public nXn As Long
Public gfqw As Long
Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Public sbsb As POINTAPI
Public Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Public Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Public Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, lparam As Any) As Long
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpvDest As Any, ByVal lpvSource As Long, ByVal cbCopy As Long)
Public Declare Function MessageBox Lib "user32" Alias "MessageBoxA" (ByVal hwnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As Long) As Long
Public Type MOUSEMSGS
x As Long 'x座标
y As Long 'y座标
a As Long
b As Long
time As Long 'Window运行时间
End Type
Public Const WH_MOUSE_LL = 14
Public Const MB_OK = &H0&
Public Const MB_ICONASTERISK = &H40&
Public Type MSLLHOOKSTRUCT
pt As POINTAPI
mouseData As Long
Flags As Long
time As Long
dwExtraInfo As Long
End Type
Public hHook As Long
'-----------------------------------------
'消息
Public Const HC_ACTION = 0
Public Const HC_SYSMODALOFF = 5
Public Const HC_SYSMODALON = 4
'鼠标消息
Public Const WM_MOUSEMOVE = &H200
Public Const WM_LBUTTONDOWN = &H201
Public Const WM_LBUTTONUP = &H202
Public Const WM_LBUTTONDBLCLK = &H203
Public Const WM_RBUTTONDOWN = &H204
Public Const WM_RBUTTONUP = &H205
Public Const WM_RBUTTONDBLCLK = &H206
Public Const WM_MBUTTONDOWN = &H207
Public Const WM_MBUTTONUP = &H208
Public Const WM_MBUTTONDBLCLK = &H209
Public Const WM_MOUSEACTIVATE = &H21
Public Const WM_MOUSEFIRST = &H200
Public Const WM_MOUSELAST = &H209
Public Const WM_MOUSEWHEEL = &H20A
Public Declare Function GetActiveWindow Lib "user32" () As Long
Public MouseMsg As MOUSEMSGS '鼠标消息结构体
Public lHook As Long '勾子句柄
Public sbss As POINTAPI
'鼠标钩子函数
Public Function HookProc(ByVal nCode As Long, ByVal wParam As Long, ByVal lparam As Long) As Long
Dim typMHS As MSLLHOOKSTRUCT, pt As POINTAPI
If wParam = WM_MOUSEMOVE Then
Call CopyMemory(typMHS, ByVal lparam, LenB(typMHS))
pt = typMHS.pt
Debug.Print "mouse Cursor at " + CStr(pt.x) + "," + CStr(pt.y)
GetCursorPos sbsb
End If
If wParam = WM_LBUTTONDOWN Then
Form1.Timer2.Enabled = True
nXn = 2
GetCursorPos sbss
End If
If wParam = WM_RBUTTONDOWN Then
End If
If wParam = WM_LBUTTONUP Then '按下中间记下这个值，然后调用一个过程，我的鼠标没有中键，自己测试一下
Form1.Timer2.Enabled = False
HookProc = CallNextHookEx(hHook, nCode, wParam, lparam)
End If
End Function
'卸载勾子
Public Sub StopHook()
If lHook <> 0 Then lHook = UnhookWindowsHookEx(lHook)
End Sub
'===================== 模块结束 ========================
Public Sub FreeHook()
If hHook <> 0 Then
Call UnhookWindowsHookEx(hHook)
hHook = 0
End If
End Sub
Public Sub EnableHook()
If hHook = 0 Then
hHook = SetWindowsHookEx(WH_MOUSE_LL, AddressOf HookProc, App.hInstance, 0)
End If
End Sub
④ vb玫瑰花数... 数字填空
PrivateSubCommand2_Click()'水仙花数153=1*1*1+5*5*5+3*3*3
Fori=10To999
Ifi<100Then
ge=iMod10
shi=i10
Ifge^3+shi^3=iThenPrint,
Else
ge=iMod10
shi=i10Mod10
=i100
Ifge*ge*ge+shi^3+^3=iThen
Printi,
geshu=geshu+1
IfgeshuMod5=0ThenPrint
EndIf
EndIf
Nexti
Printgeshu
EndSub
你的图片看不清楚
⑤ vb玫瑰花程序能开满桌面玫瑰花的小程序 源码VB!可以给我发一份吗
真好的源代码没有，有个在桌面上爬虫的小程序，
我花了很长时间编写的吗，和你的类似，
参考改一下，应该对你有用
Dim aq
Dim a(4) As Integer
Dim b(4) As Integer
Dim n, k, c As Integer, d As Integer
Private Sub Command1_Click()
Unload Form1
End Sub
Private Sub Form_Load()
App.TaskVisible = False
App.Title = " 123"
Form1.Visible = False
Form1.WindowState = 2
Call keybd_event(44, 0, 0, 0)
F
End Sub
Private Sub Form_Resize()
Picture1.Left = 0
Picture1.Top = 0
Picture1.Width = Form1.Width
Picture1.Height = Form1.Height
End Sub
Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Picture1.Circle (X, Y), 70, QBColor(1)
End Sub
Private Sub Timer1_Timer()
If aq = 2 Then
Form1.Visible = True
Picture1.Picture = Clipboard.GetData()
End If
aq = aq + 1
End Sub
Private Sub qq()
n = 0
On Error Resume Next
k = Int(Rnd() * 4)
Select Case k
Case 0
c = a(4): d = Val(Shape1(0).Height) + b(4)
Case 1
c = a(4): d = (-1) * Val(Shape1(0).Height) + b(4)
Case 2
d = b(4): c = Val(Shape1(0).Width) + a(4)
Case 3
d = b(4): c = (-1) * Val(Shape1(0).Width) + a(4)
End Select
For i = 0 To 3
For j = 0 To 3
If a(i) = c And b(j) = d Then
n = 1
End If
Next j
Next i
If c < 0 Or c > Form1.Width Or d < 0 Or d > Form1.Height Then
n = 1
End If
If n = 1 Then
qq
Else
a(4) = c
b(4) = d
End If
End Sub
Private Sub F()
For i = 0 To 4
a(i) = 500
b(i) = 500
Next i
Form1.WindowState = 2
'DrawMode = 7
For i = 1 To 4
'Load Shape1(i)
Next i
End Sub
Private Sub Timer2_Timer()
For i = 0 To 3
a(i) = a(i + 1)
b(i) = b(i + 1)
Next i
qq
For i = 0 To 4
Shape1(i).Left = a(i)
Shape1(i).Top = b(i)
Next i
End Sub
⑥ 谁有玫瑰花开放VB代码
楼主、
有个问题想你帮我下、
⑦ vb求玫瑰花数
当然不会有数字产生了，Do
While
d
<=
9这里1000-1009都不满足，验证完后，d=10，自然下次不满足d
<=
9条件就退出了
可以在每次循环结束，重新开始时加个清零操作，或者直接用for语句
⑧ 可以让玫瑰花一朵朵出现围成一个桃心的VB程序
首先你要准备一个玫瑰花图片文件，要小一点。
然后在窗体上放12个Image控件，组成一个控件数组，摆成心形，Picture属性设置为你的玫瑰花。Visibel属性全部设置为False。
在窗体上放一个Timer控件。Interval属性设置为1000，每秒显示一朵玫瑰花。
OK！你的心愿完成了！
⑨ 四叶玫瑰数的VB怎么编
四位数各位上的数字的四次方之和等于本身为四叶玫瑰数。回
实现源码答如下：
program roseNumber;
var
a,b,c,d:longint;
function four(n:longint):longint;
begin
four:=n*n*n*n;
end;
begin
for a:=1 to 9 do
for b:=0 to 9 do
for c:=0 to 9 do
for d:=0 to 9 do
begin
if(1000*a+100*b+10*c+d=four(a)+four(b)+four(c)+four(d))then
begin
writeln(a,b,c,d);
end
end
end.
⑩ vb玫瑰花程序能开满桌面玫瑰花的小程序 请注意我要的是源码VB 请发到[email protected]
程序已经发了，
代码：http://user.qzone.qq.com/471559688/blog/1310315461
代码就在QQ空间里面 ，程序我也发了 怎么还不给分啊