總網頁瀏覽量

2011年11月5日 星期六

[VB.NET] 更準確的Timer


'使用GetTickCount這個API函數作出更準確的計時!


'宣告法是:
Declare Function GetTickCount Lib "kernel32" Alias "GetTickCount" () As Long

'這個API函數會傳回由開機到現在的時間,以千份之一秒作單位,因此利用它就可以作出非常準確的計時了:

Private Declare Function GetTickCount Lib "kernel32" Alias "GetTickCount" () As Long

Private Const Interval = 1000 '一秒執行一次

Private Sub Command1_Click()
Dim ST As Long
Do
ST = GetTickCount

'**************************************
'這裡輸入要每次要做的工作,以下是例子
MsgBox "這是每一秒鐘執行的工作"
'**************************************

Do Until GetTickCount - ST >= Interval
Loop
Loop
End Sub

[VB.NET] 偵測電腦是否已上網


Private Declare Function InternetGetConnectedState Lib "wininet.dll" (ByRef lpdwFlags As Long, ByVal dwReserved As Long) As Long

Private Function IsConnected() As Boolean
IsConnected = InternetGetConnectedState(0, 0)
End Function
'使用方法:
Private Sub Command1_Click()
MsgBox IsConnected
End Sub
'如果電腦已上網會傳回true,否則傳回false。

2011年11月4日 星期五

[VB.NET] 讀取設定檔

'方法1
Name= Configuration.ConfigurationSettings.AppSettings("strName")
'方法2
'加入參考 System.Configuration
Name = ConfigurationManager.AppSettings("strName")

[VB.NET] 動態使用DLL


'原始DLL內容
Public Class Class1
    Public Sub MSG()
        MsgBox(Date.Now.Date.ToString("yyyy/MM/dd"))
    End Sub
End Class


'呼叫方法
Imports System
Imports System.Reflection
Imports System.Security.Permissions
Public Class Form1
    Dim TAA As System.Reflection.Assembly

    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        TAA = System.Reflection.Assembly.LoadFile(System.Windows.Forms.Application.StartupPath & "\888.dll")
        Dim t As Type = TAA.GetType("_888.Class1") '注意,前面有『_』喔,這是vb.net 2005預先幫你加上去的
        Dim obj As Object = t.InvokeMember(Nothing, BindingFlags.DeclaredOnly Or _
        BindingFlags.Public Or BindingFlags.NonPublic Or BindingFlags.Instance Or _
        BindingFlags.CreateInstance, Nothing, Nothing, Nothing)
        obj.msg()
    End Sub
End Class

[VB.NET] 模擬滑鼠功能


'vb.net 模擬滑鼠點下
Option Explicit On

Module MManip

    'API 定義
    Public Declare Sub Mouse_Event Lib "user32" (ByVal dwFlags As Int32, ByVal dx As Int32, ByVal dy As Int32, ByVal cButtons As Int32, ByVal dwExtraInfo As Int32)

    Public Declare Function SetCursorPos Lib "user32" (ByVal X As Int32, ByVal Y As Int32) As Int32

    Public Declare Function GetCursorPos Lib "user32" (ByRef lpPoint As POINTAPI) As Int32


    Public Const MOUSEEVENTF_LEFTDOWN = &H2
    Public Const MOUSEEVENTF_LEFTUP = &H4
    Public Const MOUSEEVENTF_MIDDLEDOWN = &H20
    Public Const MOUSEEVENTF_MIDDLEUP = &H40
    Public Const MOUSEEVENTF_RIGHTDOWN = &H8
    Public Const MOUSEEVENTF_RIGHTUP = &H10
    Public Const MOUSEEVENTF_MOVE = &H1

    Public Structure POINTAPI

        Dim X As Int32
        Dim Y As Int32

    End Structure

    '取得目前滑鼠座標
    Public Function GetCurrentPos() As POINTAPI

        Dim Position As POINTAPI
        GetCursorPos(Position)
        GetCurrentPos = Position

    End Function

    '取得目前滑鼠座標 x 值
    Public Function GetCurrentX() As int32

        Dim Position As POINTAPI
        GetCursorPos(Position)
        GetCurrentX = Position.X

    End Function

    '取得目前滑鼠座標 y 值
    Public Function GetCurrentY() As int32

        Dim Position As POINTAPI
        GetCursorPos(Position)
        GetCurrentY = Position.Y

    End Function

    '滑鼠左擊
    Public Sub LeftClick()

        LeftDown()
        LeftUp()

    End Sub

    '按下滑鼠左鍵
    Public Sub LeftDown()
        Mouse_Event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0)
    End Sub

    '放開滑鼠左鍵
    Public Sub LeftUp()
        Mouse_Event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0)
    End Sub

    '滑鼠中擊
    Public Sub MiddleClick()
        MiddleDown()
        MiddleUp()
    End Sub

    '按下滑鼠中鍵
    Public Sub MiddleDown()
        Mouse_Event(MOUSEEVENTF_MIDDLEDOWN, 0, 0, 0, 0)
    End Sub

    '放開滑鼠中鍵
    Public Sub MiddleUp()
        Mouse_Event(MOUSEEVENTF_MIDDLEUP, 0, 0, 0, 0)
    End Sub

    '移動滑鼠
    Public Sub MoveMouse(ByVal xMove As int32, ByVal yMove As int32)
        Mouse_Event(MOUSEEVENTF_MOVE, xMove, yMove, 0, 0)
    End Sub

    '滑鼠右擊
    Public Sub RightClick()
        RightDown()
        RightUp()
    End Sub

    '按下滑鼠右鍵
    Public Sub RightDown()
        Mouse_Event(MOUSEEVENTF_RIGHTDOWN, 0, 0, 0, 0)
    End Sub

    '放開滑鼠右鍵
    Public Sub RightUp()
        Mouse_Event(MOUSEEVENTF_RIGHTUP, 0, 0, 0, 0)
    End Sub

End Module

[VB.NET] 定義控制項的 提示說明 / Tooltip


1.當滑鼠移到控制項的時候會跳出一個小視窗。

 
2.VB.Net提供了更多的ToolTip的方法及屬性
System.Windows.Forms.ToolTip 類別:表示小矩形快顯視窗 (Pop-Up Window),它會在使用者將指標停留在控制項上時,顯示控制項用途的簡短說明。
System.Windows.Controls.ToolTip 類別:表示建立快顯視窗的控制項,而該快顯視窗會顯示介面中項目的資訊。

實作步驟
Step1.引用類別
Dim TipType As New ToolTip()

Step2.設定提示效果(請依個人喜好設定,若不設定也可以)
TipType.Active = True  '取得或設定值,指出工具提示目前是否在作用中。
TipType.AutomaticDelay = 200  '取得或設定工具提示的自動延遲。
TipType.AutoPopDelay = 20000    '取得或設定當指標靜止於含指定工具提示文字的控制項上時,工具提示保持可見的時間。
TipType.BackColor = Color.Black   '取得或設定工具提示的背景色彩。
'TipType.CanRaiseEvents = True  '取得值,指出元件是否能引發事件。 (繼承自 Component)。
'TipType.Container = AcceptButton   '取得包含 Component 的 IContainer。 (繼承自 Component)。
'TipType.CreateParams()    '基礎架構。取得工具提示視窗的建立參數。
'TipType.DesignMode()  '取得值,指出 Component 目前是否處於設計模式。 (繼承自 Component)。
'TipType.Events()  '取得附加在這個 Component 上的事件處理常式清單。 (繼承自 Component)。
TipType.ForeColor = Color.Lime   '取得或設定工具提示的前景色彩。
TipType.InitialDelay = 1    '取得或設定在工具提示出現之前,所經過的時間。
TipType.IsBalloon = True   '取得或設定值,指出工具提示是否應該使用汽球樣式的視窗。
TipType.OwnerDraw = True   '取得或設定值,指出要由作業系統繪製工具提示或是由您提供的程式碼繪製。
TipType.ReshowDelay = 1 '(取得或設定當指標從某個控制項移動到另一個控制項時, 在後續工具提示視窗出現之前, 必須經)
TipType.ShowAlways = True  '取得或設定值,指出即使父控制項為非現用時,是否也會顯示工具提示視窗。
'TipType.Site    '取得或設定 Component 的 ISite。 (繼承自 Component)。
TipType.StripAmpersands = True '取得或設定值,以便判斷連字號 (&) 字元的處理方式。
'TipType.Tag '取得或設定物件,其中含有與 ToolTip 關聯之程式設計人員提供的資料。
TipType.ToolTipIcon = ToolTipIcon.Info '取得或設定值,以便定義要顯示在工具提示文字旁的圖示類型。
TipType.ToolTipTitle = "test"  '取得或設定工具提示視窗的標題。
TipType.UseAnimation = True    '取得或設定值,以便判斷顯示工具提示時是否應該使用動畫效果。
TipType.UseFading = True   '取得或設定值,以便判斷顯示工具提示時是否應該使用淡出效果。
TipType.IsBalloon = True '取得或設定值,指出工具提示是否應該使用汽球樣式的視窗。


Step3.設定控制項及提示文字
TipType.SetToolTip(Me.TextBox1, "請輸入您的帳號")
TipType.SetToolTip(Me.Button1, "執行命令")

[VB.NET] 壓縮.NET程式的記憶體用量

.NET程式的記憶體用量一直以來都是程式設計師所關注的焦點。因為.NET程式必需載入.NET Framework的關係,記憶體用量動輒就至少10MB以上。






對於觀察敏銳的人來說,相信應該都有注意到某個奇特的現象,那就是當我們把程式視窗縮小至工具列時,記憶體就會驟減。





因為作業系統會把虛擬內存轉為物理內存的關係。大多數觀察到這現象的人都會利用把應用程式縮小來壓縮程式的記憶體用量。但這樣做起來有點笨拙,站在使用者的觀點來看也是怪怪的,甚至會造成使用者使用上的不便。
其實同樣的效果,我們也可以透過SetProcessWorkingSetSize API來達到。

API宣告方式
VB.NET
Private Declare Auto Function SetProcessWorkingSetSize Lib "kernel32.dll" _
(ByVal procHandle As IntPtr, ByVal min As Int32, ByVal max As Int32) As Boolean
範例程式碼
Public Class Form1

#Region "Declare"
Private Declare Auto Function SetProcessWorkingSetSize Lib "kernel32.dll" (ByVal procHandle As IntPtr, ByVal min As Int32, ByVal max As Int32) As Boolean
#End Region


#Region "Private Method"
Private Sub CompressMemory()
SetProcessWorkingSetSize(Process.GetCurrentProcess().Handle, -1, -1)
End Sub
#End Region


#Region "Event Process"
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
CompressMemory()
End Sub
#End Region
End Class