記載Windows使用的時間
有時候你需要記下每次Windows開啟和關閉的時間,下面這個小程序就可以完成這個功能,你可以把它放在Windows開始菜單的“啟動”文件夾裡面,這樣當你進入Windows時,這個小程序就會自動啟動(不可見),並在你指定的文件中寫下當時的時間,在你推出Windows系統時,小程序會關閉並記下離開的時間,並關閉記錄文件。
Private Sub Form_Load()
Left = -10000
Top = -10000
Open "c:\aPPS\log.txt" For Append As #1
Print #1, "On: " & CStr(Now)
Close #1
End Sub
Private Sub Form_Unload(Cancel As Integer)
Open "c:\aPPS\log.txt" For Append As #1
Print #1, "Off:" & CStr(Now)
Close #1
End
End Sub
Dim winHwnd As Long
Dim RetVal As Long
winHwnd = FindWindow(vbNullString, "Calculator")
Debug.Print winHwnd
If winHwnd <> 0 Then
RetVal = PostMessage(winHwnd, WM_CLOSE, 0&, 0&)
If RetVal = 0 Then
MsgBox "置入消息錯誤!"
End If
Else
MsgBox "Calculator沒有打開!"
End If
為了讓以上的代碼工作,你必須在模塊文件中什麼以下API函數:
Declare Function FindWindow Lib "user32" Alias _"FindWindowA" (ByVal lpClassName As String, _ByVal lpWindowName As String) As Long
Declare Function PostMessage Lib "user32" Alias _"PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, _ByVal wParam As Long, lParam As Any) As Long
Public Const WM_CLOSE = &H10
我怎樣確定我的程序是否在運行?
把以下代碼放在第一個窗體的Form_Load事件中:
If App.PrevInstance = True Then
Call MsgBox("這個程序正在運行!",_vbExclamation)
End
End If
怎樣延遲一個VB程序?
延遲在VB中非常有意義!舉個例子,有時你需要等待一個額外的過程完成,才能運行程序下面的代碼。延遲使程序擺脫了CPU的運算速度對程序運行速度的影響,但是在VB中卻沒有延遲這個很多語言都有的現成函數,所以還要依靠API函數,請看以下的代碼:
Declare Sub Sleep Lib "kernel32" _(ByVal dwMilliseconds As Long)
'延遲1秒
Call Sleep(1000)
怎樣改變雙擊鼠標的時間間隔?
在較短時間裡連續的點擊兩次鼠標就會造成鼠標雙擊事件。你可以調用API函數SetDoubleClickTime改變鼠標雙擊所需要的時間,它只有一個參數,並可精確到毫秒級。
Declare Function SetDoubleClickTime _Lib "user32" Alias "SetDoubleClickTime" _(ByVal wCount As Long) As Long
提示:這種改變將影響到整個操作系統。
怎樣找到鼠標指針的XY坐標?
在很多的作圖軟件中都有一個小的區域顯示當前屏幕上的光標位置,這利用API函數非常容易做到,下面的例子將演示使用代碼如何返回當前光標的XY的坐標值。
步驟:
在VB中建立一個新項目文件,Form1使用默認設置.
選擇菜單的“Project/add Module”,建立一個新的模塊文件“Moudule1”。
輸入以下代碼聲明API函數。
Option Explicit
Type POINTAPI ' Declare types
x As Long
y As Long
End Type
Declare Function GetCursorPos Lib "user32" _(lpPoint As POINTAPI) As Long ' Declare API
把焦點移到Form1,添加兩個標簽對象(Label)和一個計時器對象(Timer1),把計時器的Interval屬性設為1,然後雙擊Form1的任何區域,在代碼窗口中輸入:
Option Explicit
Dim z As POINTAPI ' 聲明變量
Private Sub Timer1_Timer()
GetCursorPos z ' 得到坐標
Label1 = "x: " & z.x ' 得到X坐標
Label2 = "y: " & z.y ' 得到Y坐標
End Sub
按F5運行程序,移動鼠標注意觀察兩個標簽對象的變化。
怎樣捕捉窗體的鼠標?
這個技巧將向您展示如何使用捕捉光標的API函數阻止鼠標指針移出窗體。
注意!:如果窗體的BorderStyle屬性被設為sizeable(2或5),則當你改變窗體的大小時鼠標就會“逃脫”程序的監控!因此你最好把BorderStyle設為0、1、3或4。
步驟:
1.把以下代碼添加如模塊:
Option Explicit
Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Declare Function ClipCursor Lib "user32" _(lpRect As Any) As Long
Public Sub DisableTrap(CurForm As Form)
Dim erg As Long
'聲明過程變量
'設置新坐標
Dim NewRect As RECT
CurForm.Caption = "釋放鼠標"
With NewRect
.Left = 0&
.Top = 0&
.Right = Screen.Width / Screen.TwipsPerPixelX
.Bottom = Screen.Height / Screen.TwipsPerPixelY
End With
erg& = ClipCursor(NewRect)
End Sub
Public Sub EnableTrap(CurForm As Form)
Dim x As Long, y As Long, erg As Long
'聲明過程變量
'設置新坐標
Dim NewRect As RECT
'得到TwipsperPixel
'窗體的ScaleMode必須設為Twips!!!
x& = Screen.TwipsPerPixelX
y& = Screen.TwipsPerPixelY
CurForm.Caption = "捕捉鼠標"
'設置光標的范圍
With NewRect
.Left = CurForm.Left / x&
.Top = CurForm.Top / y&
.Right = .Left + CurForm.Width / x&
.Bottom = .Top + CurForm.Height / y&
End With
erg& = ClipCursor(NewRect)
End Sub
2.在窗體上添加兩個命令按鈕(Command Button)。
3.把以下代碼添加如Form1。
Private Sub Command1_Click()
EnableTrap Form1
End Sub
Private Sub Command2_Click()
DisableTrap Form1
End Sub
Private Sub Form_Unload(Cancel As Integer)
'程序結束時釋放鼠標。
DisableTrap Form1
End Sub
怎樣使我的程序總處於屏幕最前方?(Always on top)
如果你想讓你的程序處於前方,可以使用以下代碼:
Form1.ZOrder
配合計時器使用,每隔一段很小的時間間隔調用這種方法可以使窗體Form1處於屏幕前方,但是用戶還是可能使別的窗體在短暫的時間裡處於Form1的上方。所以這種方法並不能使窗體真正的實現Always on top,而要真正的Always on top可以使用API函數SetWindowPos,代碼如下:
'聲明函數:
Declare Function SetWindowPos Lib "user32" _(ByVal h%, ByVal hb%, ByVal x%, ByVal y%, _ByVal cx%,ByVal cy%,ByVal f%) As Integer
Global Const SWP_NOMOVE = 2
Global Const SWP_NOSIZE = 1
Global Const FLAGS = SWP_NOMOVE Or SWP_NOSIZE
Global Const HWND_TOPMOST = -1
Global Const HWND_NOTOPMOST = -2
'把窗體放在最前面:
res% = SetWindowPos (Form1.hWnd, HWND_TOPMOST, _
0, 0, 0, 0, FLAGS)
'如果res%=0, 就產生錯誤
'使窗體恢復普通模式:
res% = SetWindowPos (Form1.hWnd, HWND_NOTOPMOST, _0, 0, 0, 0, FLAGS)
怎樣得到文本框(TextBox)中的文本行數?
計算文本框中輸入文本的行數可以使用SendMessage函數返回,當一行文字發生環繞時,它將被當作新的一行,而被非簡單的計算文本中的換行符個數。
把以下API函數的聲明添入模塊文件的general declarations區域,如果您使用的是VB4-32或VB5,也可以把此聲明添入Form1的general declarations中,並把所有的“Public”更換為“Private”。
Option Explicit
Public Declare Function SendMessageLong Lib _"user32" Alias "SendMessageA" _(ByVal hwnd As Long, _ ByVal wMsg As Long, _ ByVal wParam As Long, _ByVal lParam As Long) As Long
Public Const EM_GETLINECOUNT = &HBA
Form Code
Sub Text1_Change()
Dim lineCount as Long
On Local Error Resume Next
'得到/顯示文本行數
lineCount = SendMessageLong(Text1.hwnd, EM_GETLINECOUNT, 0&, 0&)
Label1 = Format$(lineCount, "##,###")
End Sub
注釋:為了使本程序成功,請在設計階段把文本框的Multiline屬性設為True。
怎樣使程序的標題條閃爍?
建立新的項目文件,添加模塊文件,並填寫如下代碼:
Public Declare Function FlashWindow _Lib "user32" (ByVal hwnd As Long, _ByVal bInvert As Long) As Long
在窗體中添加兩個按鈕和一個計時器,並用設置以下屬性:
command1.caption="開始"
command2.caption="停止"
timer1.interval=500 '每0.5秒閃爍一次
timer1.enabled=false
Private Sub Timer1_Timer()
a& = FlashWindow(Me.hwnd, 1)
End Sub
Private Sub Command1_Click()
Timer1.Enabled = True
End Sub
Private Sub Command2_Click()
Timer1.Enabled = False
End Sub