重庆分公司,新征程启航
为企业提供网站建设、域名注册、服务器等服务
制作屏保程序有现成的工具,别费劲了,又卖不出去,浪费生命
10年的蓬莱网站建设经验,针对设计、前端、开发、售后、文案、推广等六对一服务,响应快,48小时及时工作处理。成都营销网站建设的优势是能够根据用户设备显示端的尺寸不同,自动调整蓬莱建站的显示方式,使网站能够适用不同显示终端,在浏览器中调整网站的宽度,无论在任何一种浏览器上浏览网站,都能展现优雅布局与设计,从而大程度地提升浏览体验。创新互联从事“蓬莱网站设计”,“蓬莱网站推广”以来,每个客户项目都认真落实执行。
'这个拿去试一试,两个时钟,两个图片框,自己设定图片框2的大小,比如让它和窗体一样大
'查一查PaintPicture的用法,就明白了
'去掉Picture2
Dim Pic_num As Long
Dim Pic_name() As String
Dim pic_star As Long
Dim p_width As Single
Dim p_height As Single
Dim bili_w As Single
Dim bili_h As Single
Dim v_mod As Long
Private Sub Form_Load()
Dim L_name As String
Pic_num = 0
ReDim Pic_name(Pic_num)
L_name = Dir(App.Path "\pic\*.JPG")
Do While L_name ""
ReDim Preserve Pic_name(Pic_num)
Pic_name(Pic_num) = L_name
Pic_num = Pic_num + 1
L_name = Dir
Loop
L_name = Dir(App.Path "\pic\*.BMP")
Do While L_name ""
ReDim Preserve Pic_name(Pic_num)
Pic_name(Pic_num) = L_name
Pic_num = Pic_num + 1
L_name = Dir
Loop
Picture1.AutoSize = True
Picture1.AutoRedraw = True
Picture1.Visible = False
' Me.AutoSize = False
Me.AutoRedraw = True
Me.Visible = True
Timer1.Interval = 10
Timer1.Enabled = False
Timer2.Interval = 50
Timer2.Enabled = False
If Pic_num 0 Then
Picture1.Picture = LoadPicture(App.Path "\pic\" Pic_name(0))
Me.PaintPicture Picture1.Picture, 0, 0, Me.ScaleWidth, Me.ScaleHeight, 0, 0, Picture1.ScaleWidth, Picture1.ScaleHeight
Timer1.Enabled = True
Timer1.Interval = 2000
Else
MsgBox ("没有图片显示!")
End If
End Sub
Private Sub Form_Resize()
Me.Width = Me.Width
Me.Height = Me.Width
Me.Top = 0
Me.Left = 0
End Sub
Private Sub Timer1_Timer()
Dim L_id As Long
Randomize
L_id = Int((Pic_num) * Rnd)
Picture1.Picture = LoadPicture(App.Path "\pic\" Pic_name(L_id))
bili_w = Picture1.ScaleWidth / Me.ScaleWidth
bili_h = Picture1.ScaleHeight / Me.ScaleHeight
p_width = Me.Width / 100
p_height = Me.Height / 100
pic_star = 0
Randomize
v_mod = Int(10 * Rnd)
'v_mod = 9'取消单引号并修改常数数可看单一效果
Timer1.Enabled = False
Timer2.Enabled = True
End Sub
Private Sub Timer2_Timer()
If pic_star 101 Then
pic_star = pic_star + 1
Select Case v_mod
Case 0
Me.PaintPicture Picture1.Picture, 0, 0, Me.Width, pic_star * p_height, 0, 0, Picture1.Width, bili_h * pic_star * p_height '从上向下
Case 1
Me.PaintPicture Picture1.Picture, 0, 0, pic_star * p_width, Me.Height, 0, 0, bili_w * pic_star * p_width, Picture1.Height '从左向右
Case 2
Me.PaintPicture Picture1.Picture, 0, 0, Me.Width, pic_star * p_height, 0, 0, Picture1.Width, Picture1.Height '压缩的从上向下
Case 3
Me.PaintPicture Picture1.Picture, 0, 0, pic_star * p_width, Me.Height, 0, 0, Picture1.Width, Picture1.Height '压缩的从左向右
Case 4
Me.PaintPicture Picture1.Picture, 0, 0, pic_star * p_width, pic_star * p_height, 0, 0, Picture1.Width, Picture1.Height '压缩的从左上向右下
Case 5
Me.PaintPicture Picture1.Picture, Me.Width - pic_star * p_width, Me.Height - pic_star * p_height, pic_star * p_width, pic_star * p_height, 0, 0, Picture1.Width, Picture1.Height '压缩的从右下向左上
Case 6
Me.PaintPicture Picture1.Picture, Me.Width / 2 - pic_star * p_width / 2, 0, pic_star * p_width / 2, Me.Height, 0, 0, Picture1.Width / 2, Picture1.Height '压缩的从中向左
Me.PaintPicture Picture1.Picture, Me.Width / 2, 0, pic_star * p_width, Me.Height, Picture1.Width / 2, 0, Picture1.Width, Picture1.Height '压缩的从中向右
Case 7
Me.PaintPicture Picture1.Picture, 0, Me.Height / 2 - pic_star * p_height / 2, Me.Width, pic_star * p_height / 2, 0, 0, Picture1.Width, Picture1.Height / 2 '压缩的从中向上
Me.PaintPicture Picture1.Picture, 0, Me.Height / 2, Me.Width, pic_star * p_height, 0, Picture1.Height / 2, Picture1.Width, Picture1.Height '压缩的从中向下
Case 8
Me.PaintPicture Picture1.Picture, Me.Width / 2 - pic_star * p_width / 2, Me.Height / 2 - pic_star * p_height / 2, pic_star * p_width / 2, pic_star * p_height / 2, 0, 0, Picture1.Width / 2, Picture1.Height / 2 '压缩的从中向左上
Me.PaintPicture Picture1.Picture, Me.Width / 2, Me.Height / 2, pic_star * p_width, pic_star * p_height, Picture1.Width / 2, Picture1.Height / 2, Picture1.Width, Picture1.Height '压缩的从中向右下
Me.PaintPicture Picture1.Picture, Me.Width / 2, Me.Height / 2 - pic_star * p_height / 2, pic_star * p_width / 2, pic_star * p_height / 2, Picture1.Width / 2, 0, Picture1.Width / 2, Picture1.Height / 2 '压缩的从中向右上
Me.PaintPicture Picture1.Picture, Me.Width / 2 - pic_star * p_width / 2, Me.Height / 2, pic_star * p_width / 2, pic_star * p_height / 2, 0, Picture1.Height / 2, Picture1.Width / 2, Picture1.Height / 2 '压缩的从中向左下
Case 9
For k = 0 To 9
Me.PaintPicture Picture1.Picture, 0, k * Me.Height / 10, Me.Width, 5 * pic_star * p_height / 10, 0, k * (Picture1.Height / 10), Picture1.Width, (Picture1.Height / 10) '水平百叶窗
Next
If pic_star = 21 Then
pic_star = 101
End If
End Select
Else
pic_star = 0
Timer1.Enabled = True
Me.PaintPicture Picture1.Picture, 0, 0, Me.ScaleWidth, Me.ScaleHeight, 0, 0, Picture1.ScaleWidth, Picture1.ScaleHeight
Timer2.Enabled = False
End If
End Sub
'这回做了9个,应该明白了吧,其实你第一回的5分也应该给选我,估计是你没明白用法
本实例的项目文件SCRNSAVE.MAK中包括两个文件: SCRNSAVE.BAS、BLANK.FRM。这两个文件的作用分别说明如下。
一、SCRNSAVE.BAS
此模块文件包含四个子程序: HideMouse,ShowMouse,EndScrnsave,Main。前三个子程序分别用于隐藏鼠标光标、重新显示鼠标光标和结束屏幕保护程序返回Windows。当在Windows控制面板的桌面对话框中对屏幕保护程序进行“设置”时,Windows会传给相应的屏幕保护程序一个命令行参数Command$,此命令行参数含有“/c”开关,要求屏幕保护程序提供自己的设置对话框。当在桌面对话框中对屏幕保护程序进行“测试”或在设定的时间内无键盘和鼠标操作而激活屏幕保护程序时,Command$中含有“/s”开关,要求屏幕保护程序立即开始运行。本文提供的屏幕保护程序实例在启动时首先执行Main子程序,Main子程序通过检查Command$来决定后续操作。若Command$中含有“/c”开关,则利用MsgBox显示简单的提示信息, 说明本程序未提供任何设置选项;若Command$中含有“/s”开关,则启动一覆盖全屏幕的黑色窗体BlankForm,并在此窗体上显示动画,进行正常的屏幕保护工作。
为了在程序启动时首先执行Main子程序,应从VB的Options菜单中选择“Project...”项,在Project Options对话框中把Start Up Form设置为“Sub Main”。
二、BLANK.FRM
此文件是屏幕保护程序的主体。它负责建立一个覆盖全屏幕的黑色窗体BlankForm,并在此窗体上显示动画。它还负责监视键盘和鼠标事件,一旦有键盘或鼠标动作,则立即结束屏幕保护程序的运行返回Windows。为了建立一个无边框、无标题条的覆盖全屏幕的黑色窗体,需将BlankForm窗体属性中的BorderStyle置为0-None,Caption置为空,ControlBox置为False,BackColor置为&H00000000&,并在Form_Load中利用Move 0,0,Screen.Width,Screen.Height将其放大为覆盖整个屏幕。
本例显示的动画是根据《电脑爱好者》1995年第8期“动画制作秘籍(一)”中的CIRCSHOW.BAS程序改编而成。动画部分是屏幕保护程序中最精彩的部分。实际上,它也是读者为了编写自己的屏幕保护程序而唯一需要修改的部分,也是读者的创意可以尽情发挥的部分。读者可以充分发挥自己的想象力和创造力,编写出精美动人的动画。本例通过Form_KeyDown和Form_MouseMove来监视键盘和鼠标事件的发生。一旦有键盘输入,则立即结束屏幕保护程序的运行,返回Windows。鼠标则必须在移动了至少三个像素时方能结束屏幕保护程序的运行,这样可避免因敲工作台等偶然的事件而使屏幕保护程序的运行中断。
在建立了以上两个文件后,将其加到项目文件SCRNSAVE.MAK中,生成EXE文件。在生成EXE文件时, 应注意如下两点:
1.在Make EXE File对话框的“Application Title”域中应填写一个特殊的名字。这个名字必须以“SCRNSAVE”打头,随后是你要在控制面板的屏幕保护程序清单中显示的名字。例如, 本例所用标题为“SCRNSAVE VB Screen Saver”。
2.生成的EXE文件的扩展名必须为SCR而不能是EXE。本例所取EXE文件名为SSVB.SCR(按照惯例所有的屏幕保护程序的名字都以SS打头)。读者所要做的最后一件事是将SSVB.SCR拷到自己的Windows目录下, 这样Windows才能找到它, 并在控制面板的屏幕保护程序清单中显示出来。本文实例在PWIN 3.2、VB 3.0环境下调试通过。
清单1: SCRNSAVE.BAS
Declare Function ShowCursor Lib 〃USER〃 (ByVal fShow As Integer) As Integer
Sub EndScrnsave ()
ShowMouse ′使鼠标重新可见
End ′然后退出屏幕保护程序
End Sub
Sub ShowMouse ()
′这个子程序使鼠标箭头重新出现在屏幕上
While ShowCursor(True) 0
Wend
End Sub
Sub HideMouse ()
′这个子程序把屏幕上的鼠标箭头隐蔽起来
While ShowCursor(False) = 0
Wend
End Sub
Sub Main ()
′只允许屏幕保护程序的一个实例运行
If App.PrevInstance=True Then
Exit Sub
End If
′检查一下应该空屏还是显示设置对话框
If InStr(Command$, 〃/c〃) Then
MsgBox 〃No setup options for this screen saver〃 ′显示设置对话框
ElseIf InStr(Command$, 〃/s〃) Then
BlankForm.Show ′开始运行屏幕保护程序
End If
′等到没有要显示的窗体时就退出
While DoEvents() 0
Wend
End Sub
清单2: BLANK.FRM
(1)窗体和控制属性
对象 属性设置
FormBackColor &H00000000&
BorderStyle 0-None
Caption
ControlBox False
Name BlankForm
ScaleMode3-PixelTimerInterval1NameTick
(2)窗体程序
Dim r, f, p, X0, Y0
Dim lastX, lastY
Const pi = 3.14159
Sub Form_Load ()
Move 0, 0, Screen.Width, Screen.Height ′将窗体放大到覆盖全屏幕
HideMouse
r = 50
p = 0
f = 0
X0 = ScaleWidth / 2 - 1
Y0 = ScaleHeight / 2 - 1
End Sub
Sub Form_KeyDown (KeyCode As Integer, Shift As Integer)
EndScrnsave ′结束屏幕保护程序的运行
End Sub
Sub Form_MouseMove (Button As Integer, Shift As Integer,
X As Single, Y As Single)
If IsEmpty(lastX) Or IsEmpty(lastY) Then
lastX = X
lastY = Y
End If
′仅当鼠标移动足够迅速(一次2个象素以上)才恢复屏幕
If Abs(lastX - X) 2 Or Abs(lastY - Y) 2 Then
EndScrnsave ′结束屏幕保护程序
End If
lastX = X
lastY = Y ′记住最后的位置
End Sub
Sub Tick_Timer ()
Dim X As Single
Dim Y As Single
If f = 0 Then
c = RGB(255 * Rnd, 255 * Rnd, 255 * Rnd)
X = r * Cos(2 * pi * p / 360) + X0
Y = r * Sin(2 * pi * p / 360) + Y0
Line (X0, Y0)-(X, Y), c
Circle (X, Y), 2, c
If r = 200 Then
f = 1
Exit Sub
End If
r = r + 1 / 2
p = p + 7
ElseIf f = 1 Then
c = RGB(0, 0, 0)
X = r * Cos(2 * pi * p / 360) + X0
Y = r * Sin(2 * pi * p / 360) + Y0
Line (X0, Y0)-(X, Y), c
Circle (X, Y), 2, c
If r = 50 Then
f = 0
Exit Sub
End If
r = r - 1 / 2
p = p - 7
End If
End Sub
系统就有这个屏保啊!~!
Option EXPlicit
Dim quitflag As Boolean '声明终止程序标志变量
Dim lleft
'声明隐藏或显示鼠标的API函数
Private Declare Function ShowCursor Lib "user32"
(ByVal bShow As Long) As Long
'检测鼠标单击或移动
Private Sub Form_Click()
quitflag = True
End Sub
Private Sub Form_MouseMove(Button As Integer,Shift As Integer, X As Single, Y As Single)
Static xlast, ylast
Dim xnow As Single
Dim ynow As Single
xnow = X
ynow = Y
If xlast = 0 And ylast = 0 Then
xlast = xnow
ylast = ynow
Exit Sub
End If
If xnow xlast Or ynow ylast Then
quitflag = True
End If
End Sub
'检测按键
Private Sub Form_KeyDown(KeyCode As Integer,Shift As Integer)
quitflag = True
End Sub
Private Sub Form_Load()
Dim X As Long
lleft = 0
'横向滚动文字的起始X坐标
If App.PrevInstance = True Then
'用APP对象的PrevInstance属性
Unload Me
'防止同时运行屏幕保护程序的两个实例
Exit Sub
End If
Select Case Ucase$(Left$(Command$, 2))
'装载命令行参数
Case "/S" '在显示器属性对话框中单击了
预览按钮或屏幕保护程序被系统正常调用。
Show
'全屏显示Form1窗体
Randomize
'初始化随机数生成器
X = ShowCursor(False)
'隐藏鼠标
BackColor = VBBlack
Do
Timer2.Enabled = True
'启动Timer2 ,显示屏幕保护滚动文字
DoEvents
'转让控制权,以便检测鼠标和按键行为
Loop Until quitflag = True
'运行屏幕保护滚动文字直至有鼠标和按键行为
Timer2.Enabled = False
'终止滚动文字
Timer1.Enabled = True
'启动Timer1,退出屏幕保护程序
Case Else
Unload Me
Exit Sub
End Select
End Sub
Private Sub Form_Unload(Cancel As Integer)
Dim X
X = ShowCursor(True)
'显示鼠标
End Sub
Private Sub Timer1_Timer()
Unload Me
'退出屏幕保护程序
End Sub
Private Sub Timer2_Timer()
显示横向滚动文字
lleft = lleft + 100
If lleft = 11810 Then
lleft = 0
Lab1.Top = Int(Rnd * 7000)
End If
Lab1.Left = lleft
Timer2.Enabled = False
End Sub
思路:
利用几个可以作为容器的控件,添加滚动条就可以了:
我举个例子:(这个问题我记得回答过的!)
添加1个PicTureBox1,作为容器
在PicTureBox1里添加PicTureBox2,在窗体上添加一个垂直滚动条。
把你所谓的许多控件放到PicTureBox2里,滚动条改变的是PicTureBox2在PicTureBox1里的Top属性,我想你通过一定的空间想象力,可以想到效果了吧?
注意:默认状态设置PicTureBox2的Top属性为0,当该属性为负值的时候,PicTureBox2显示的效果是向上移动,即下面原来隐藏的内容为可见了。
要设置PicTureBox2的AutoRedraw 属性为True。
若要左右移动效果,那么改变其 Left 属性,原理不再赘述了。
在窗体上建立2个文本框text1和text2,一个按钮command1,text1里面输入你要转换的字符串,text2里面显示结果,代码如下:
Dim MyString As String
Dim EveryStr(50) As String
Dim TargetStr As String
Private Sub Command1_Click()
MyString = Text1
For i = 1 To Len(MyString)
EveryStr(i) = Right(Left(MyString, i), 1)
If Asc(EveryStr(i)) 123 And Asc(EveryStr(i)) 96 Then EveryStr(i) = \"_\"
If Asc(EveryStr(i)) 91 And Asc(EveryStr(i)) 64 Then EveryStr(i) = \"_\"
TargetStr = TargetStr EveryStr(i)
Next i
Text2 = TargetStr
TargetStr = \"\"
End Sub
引号前面怎么自动给加了个“\”?用的时候请手动把那几个“\”去掉