1.让你的程序只运行一次
你自己编写的程序是否可以运行多个,你是否看见有些程序运行多个时会提示程序已正在运行,下面就让我们来实现这个功能,其实非常简单,只要用APP的一个方法就可以了,在程序加载时,调用一下APP的PrevInstance方法就可以检测程序是否正在运行,程序好下
建立一个窗体,在代码中输入如下代码即可:
Option Explicit
Private Sub Form_Load()
If App.PrevInstance Then
MsgBox "The programe is running now,you shouldn't run the program again!", vbOKOnly + vbExclamation, "imformation"
End
End If
End Sub
2调用系统文件夹
你是否可以用Commandialog控件轻易的调用系统中的文件,你可知怎样调用系统中的文件夹呢?看了下面的你就知道了:
首先用CreateObject函数来创建一个shell.application对象.Set a = CreateObject("shell.application"),然后给这个对象的BrowseForFolder传递"窗体的句柄,select folder和0"参数,调用过程已经完成,为了得到路径和文件夹名,我们将返回值传递给另一个对象b,然后就可以调用b的两个方法即可得到文件夹路径和文件夹名,相关程序如下:
建立一个窗体,添加两个TEXT控件,分别命名为text1,text2;另外添加一个命令按钮Command1,在代码中添加好下代码:
Option Explicit
Private Sub Command1_Click()
On Error Resume Next
Dim a As Object
Set a = CreateObject("shell.application")
Dim b As Object
Set b = a.BrowseForFolder(Me.hWnd, "select folder", 0)
Text1 = b.Title
Text2 = b.Self.Path
End Sub
text1就显示文件夹名,text2显示文件夹路径
3.关闭窗体前提示
你是否当心一不小心关掉窗体而又要重新运行程序,但却某些结果没有保存下来,就像记事本一样,那你就得在关闭窗体前提示用户是否关闭.具体我就不说了,太简单,就是改变Form_Unload方法中cancel的值,建立一个窗体,输入代码如下:
Option Explicit
Private Sub Form_Unload(Cancel As Integer)
If MsgBox("Are you sure to exit?", vbYesNo + vbInformation, "imformation") = vbYes Then
Unload Me
Else
Cancel = 1
End If
End Sub
4.文本框输入发声
你是否用过金山打字,当你按下一个键时,发出一种清脆的声音,你是否觉得感觉很特别,其实你也能,建立一个标准模块,输入代码如下:
Option Explicit
Dim Play As Boolean
Public Sub Click(FRM As Form)
With FRM.MMC_Click
If Play Then
.Command = "close"
End If
.FileName = App.Path + "\type.wav" '指定路径
.Command = "open" '打开路径
.Command = "play" '播放路径中的文件
Play = True
End With
End Sub
建立一个窗体,添加一个文本框控件Text1,再添加一个MMC控件(Micorsoft Multimedia Control 6.0),命名为MMC_Click,输入以下代码:
Option Explicit
Private Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer)
Click Me
End Sub
然后在程序当前目录下添加一个你想要发出声音的文件(WAV文件),命名为type.wav,运行程序后时,在文本框中输入字符,你就听到了你想要的声音.
5.设置窗体透明度,并实现窗体渐入淡出
设置窗体透明度要用到三个API函数SetWindowLong,SetLayeredWindowAttributes和GetWindowLong,建立一个模块,输入代码如下:
Option Explicit
Private Declare Function GetWindowLong Lib "user32.dll" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetLayeredWindowAttributes Lib "user32.dll" (ByVal hwnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
Private Declare Function SetWindowLong Lib "user32.dll" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Const LWA_ALPHA = &H2
Private Const LWA_COLORKEY = &H1
Private Const GWL_EXSTYLE = -20
Private Const WS_EX_LAYERED = &H80000
Public Sub setFRM(FRM As Form, ByVal limpid As Long) ' 设置窗体透明度
Call SetWindowLong(FRM.hwnd, GWL_EXSTYLE, GetWindowLong(FRM.hwnd, GWL_EXSTYLE) Or WS_EX_LAYERED)
Call SetLayeredWindowAttributes(FRM.hwnd, 0, limpid, LWA_ALPHA) 'limpid在0--255之间
End Sub
调用setFRM就可设置窗体的透明度了,第二个参数要设置在0---255之间,0代表全透明,255代表不透明
设置窗体透明度的工作已经完成,下面让我们来实现窗体的渐入淡出吧:
建立一个窗体,添加一个Timer控件Timer1,Interval 属性值设置为10,在代码中,定义一个全局变量FRMshow用来控制程序是运行还是关闭,定义一个全局变量I来控制加载和退出时的透明度,在Timer1的Timer方法中处理窗体的渐入淡出功能,代码如下:
Option Explicit
Dim FRMshow As Boolean
Private Sub Form_Load()
setFRM Me, 0
FRMshow = True
End Sub
Private Sub Form_Unload(Cancel As Integer)
FRMshow = False
Timer1.Enabled = True
If i > 0 Then
Cancel = 1
End If
End Sub
Private Sub Timer1_Timer()
If FRMshow = True Then
i = i + 3
If i >= 255 Then
i = 255: Timer1.Enabled = False
End If
Else
i = i - 3
If i <= 0 Then
i = 0: End
End If
End If
setFRM Me, i
End Sub
运行程序就会出现你想要的渐入淡出的效果,其改变的速度,你可以根据Timer1的Interval 属性控制,还可以根据Timer1的Timer方法中的幅度进行控制.
6.移动没有标题栏的窗体
当你的窗体想设置为一个很有特性的标题栏时或有其它用处不想要标题栏,但你还是想移动窗体时,,你会将窗体的BorderStyle属性设置为0,那么如何来移动一个没有标题栏的窗体呢,以下以不想要标题栏的为例,建立一个窗体,添加一个命令按钮Command1,用来退出程序,将窗体的BorderStyle属性设置为0,然后分别处理鼠标被按下,移动,放开的事件,代码如下:
Option Explicit
Dim FRMX As Long
Dim FRMY As Long
Dim MouseX As Long
Dim MouseY As Long
Private Sub Command1_Click()
Unload Me
End Sub
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = vbLeftButton Then
MouseX = X: MouseY = Y
End If
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = vbLeftButton Then
FRMX = Me.Left + X - MouseX
FRMY = Me.Top + Y - MouseY
Me.Move FRMX, FRMY
End If
End Sub
运行程序,你就可以移动一个没有标题栏的窗体了,要想设计一个特别的标题栏也就不困难了
7.运行任意扩展名的文件和文件夹
你可能曾经通过Shell函数来调用过可执行文件,比如Shell "1.exe",但是你是否因为调用一个TXT文件,Shell "1.txt",而无法运行而苦恼,因为Shell 只能调用可执行文件,其种类只有四种,下面让我来消除你的烦劳,让我们一起开开心心的编程.
本程序要用到一个API函数ShellExecute,这个函数可以调用任何类型的文件和文件夹.下面我们要用到前面我所讲的东西,第二点调用文件夹,建立一个窗体,添加一个CommonDialog控件CommonDialog1,四个命令按钮,命名为Command1--Command4,分别用来运行文件,调用文件,运行文件夹,调用文件夹,在代码中输入以下代码:
Option Explicit
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Dim b As Object
Private Sub Command1_Click()
If CommonDialog1.FileName <> "" Then
ShellExecute Me.hwnd, "open", CommonDialog1.FileName, vbNullString, vbNullString, vbNormalFocus
End If
End Sub
Private Sub Command2_Click()
CommonDialog1.ShowOpen
End Sub
Private Sub Command3_Click()
If b.Title <> "" Then
ShellExecute Me.hwnd, "open", b.self.Path, vbNullString, vbNullString, vbNormalFocus
End If
End Sub
Private Sub Command4_Click()
Dim a As Object
Set a = CreateObject("shell.application")
Set b = a.BrowseForFolder(Me.hwnd, "select folder", 0)
End Sub
这个程序就可以实现在程序中运行系统中所有的文件和文件夹了
先写到这吧,有点累了,以后再写
参考:http://hi.baidu.com/pcrazyc
