vbtips3.htm

所有我收藏的VB技巧

        Dim RightNow As TimeOfDay<br>
        If Time &gt;= #12:00:00 AM# And Time &lt; #12:00:00 PM#
        Then<br>
        RightNow = Morning<br>
        ElseIf Time &gt;= #12:00:00 PM# And Time &lt; #6:00:00
        PM# Then<br>
        RightNow = Afternoon<br>
        ElseIf Time &gt;= #6:00:00 PM# Then<br>
        RightNow = Evening<br>
        End If<br>
        End Sub <br>
        <a href="#home">返回</a></p>
        <p><a name="tips5"></a><strong>动态改变屏幕设置 </strong><br>
        我们经常看到许多 Win95
        的应用程序（尤其是游戏）在运行它的时候改变屏幕的设置，运行完后恢复，在
        VB 中，我们可以用以下方法实现： <br>
        '- 定义<br>
        Private Declare Function lstrcpy _<br>
        Lib &quot;kernel32&quot; Alias &quot;lstrcpyA&quot; _<br>
        (lpString1 As Any, lpString2 As Any) _<br>
        As Long<br>
        Const CCHDEVICENAME = 32<br>
        Const CCHFORMNAME = 32<br>
        Private Type DEVMODE<br>
        dmDeviceName As String * CCHDEVICENAME<br>
        dmSpecVersion As Integer<br>
        dmDriverVersion As Integer<br>
        dmSize As Integer<br>
        dmDriverExtra As Integer<br>
        dmFields As Long<br>
        dmOrientation As Integer<br>
        dmPaperSize As Integer<br>
        dmPaperLength As Integer<br>
        dmPaperWidth As Integer<br>
        dmScale As Integer<br>
        dmCopies As Integer<br>
        dmDefaultSource As Integer<br>
        dmPrintQuality As Integer<br>
        dmColor As Integer<br>
        dmDuplex As Integer<br>
        dmYResolution As Integer<br>
        dmTTOption As Integer<br>
        dmCollate As Integer<br>
        dmFormName As String * CCHFORMNAME<br>
        dmUnusedPadding As Integer<br>
        dmBitsPerPel As Integer<br>
        dmPelsWidth As Long<br>
        dmPelsHeight As Long<br>
        dmDisplayFlags As Long<br>
        dmDisplayFrequency As Long<br>
        End Type<br>
        Private Declare Function _<br>
        ChangeDisplaySettings Lib _<br>
        &quot;User32&quot; Alias
        &quot;ChangeDisplaySettingsA&quot; (_<br>
        ByVal lpDevMode As Long, _<br>
        ByVal dwflags As Long) As Long<br>
        '- 函数<br>
        Public Function SetDisplayMode(Width As _<br>
        Integer,Height As Integer, Color As _<br>
        Integer) As Long<br>
        Const DM_PELSWIDTH = &amp;H80000<br>
        Const DM_PELSHEIGHT = &amp;H100000<br>
        Const DM_BITSPERPEL = &amp;H40000<br>
        Dim NewDevMode As DEVMODE<br>
        Dim pDevmode As Long<br>
        With NewDevMode<br>
        .dmSize = 122<br>
        If Color = -1 Then<br>
        .dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT<br>
        Else<br>
        .dmFields = DM_PELSWIDTH Or _<br>
        DM_PELSHEIGHT Or DM_BITSPERPEL<br>
        End If<br>
        .dmPelsWidth = Width<br>
        .dmPelsHeight = Height<br>
        <br>
        If Color &lt;&gt; -1 Then<br>
        .dmBitsPerPel = Color<br>
        End If<br>
        End With<br>
        pDevmode = lstrcpy(NewDevMode, NewDevMode)<br>
        SetDisplayMode = ChangeDisplaySettings(pDevmode, 0)<br>
        End Function<br>
        例子调用：改变为 640x480x24位： <br>
        i = SetDisplayMode(640, 480, 24) <br>
        如果成功返回 0 。 <br>
        <a href="#home">返回</a></p>
        <p><a name="tips6"></a><strong>移动没有标题栏的窗口
        </strong><br>
        我们一般是用鼠标按住窗口的标题栏，然后移动窗口，当窗口没有标题栏时，我们可以用下面的方法来移动窗口：
        <br>
        在 BAS 文件中声明： <br>
        Declare Function ReleaseCapture Lib &quot;user32&quot; ()
        As Long<br>
        Declare Function SendMessage Lib &quot;user32&quot; _<br>
        Alias &quot;SendMessageA&quot; ( _<br>
        ByVal hwnd As Long, ByVal wMsg As Long, _<br>
        ByVal wParam As Long, lParam As Any) As Long<br>
        Public Const HTCAPTION = 2<br>
        Public Const WM_NCLBUTTONDOWN = &amp;HA1 <br>
        然后，在 Form_MouseDown 事件中： <br>
        Private Sub Form_MouseDown(Button As Integer, Shift As
        Integer, X As Single, Y As Single)<br>
        ReleaseCapture<br>
        SendMessage hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&amp;<br>
        End Sub<br>
        <a href="#home">返回</a></p>
        <p><a name="tips7"></a><strong>快速选择全部项目 </strong><br>
        我们在使用 List
        控件时，经常需要全部选择其中的项目，在项目较少时，我们可以逐项设置
        Selected
        来选择全部的项目，但当项目较多时，这样做就比较费时，其实，我们可以用
        API 函数来简单实现此功能： <br>
        Dim nRet As Long <br>
        Dim bState as Boolean <br>
        bState=True <br>
        nRet = SendMessage(lstList.hWnd, LB_SETSEL, bState, -1) <br>
        函数声明： <br>
        Public Declare Function SendMessage Lib
        &quot;User32&quot; Alias &quot;SendMessageA&quot; ( ByVal
        hWnd As Long, ByVal wMsg As Integer, ByVal wParam As
        Long, ByVal lParam As Long) As Long<br>
        Public Const WM_USER = &amp;H400<br>
        Public Const LB_SETSEL = (WM_USER + 6) <br>
        <a href="#home">返回</a></p>
        <p><a name="tips8"></a><strong>真正删除数据库的记录
        </strong><br>
        大家知道，缺省情况下，VB
        删除记录只是把记录作上个删除标志而已，并没有真正删除。要真正删除记录，你可以使用
        VB 提供的以下方法：BeginTrans、CommitTrans、RollBack。其中，BeginTrans
        方法开始记录数据库的变动，CommitTrans
        方法确认数据库的变动，而 RollBack
        方法则可以恢复被删除或修改的记录。它们可以嵌套使用。因此，要恢复被删除的记录，应该在使用
        BeginTrans 方法之后及使用 CommiTrans
        方法之前使用 RollBack 方法。<br>
        <a href="#home">返回</a></p>
        <p><a name="tips9"></a><strong>捕捉 MoueExit 事件</strong><br>
        MouseDown、MouseUp、MouseMove。VB
        似乎提供了很好的 Mouse 事件。但好象还缺少什么！对！还差
        MouseExit（鼠标移出）事件。在 VB 中，我们要捕捉
        MouseExit 事件，必须用 API 函数： <br>
        Private Declare Function SetCapture Lib
        &quot;user32&quot; (ByVal hWnd As Long) As Long<br>
        Private Declare Function ReleaseCapture Lib
        &quot;user32&quot; () As Long <br>
        然后，我们可以在控件（以 Picture1
        为例）的 MouseMove 事件上加上以下代码： <br>
        Dim MouseExit As Boolean<br>
        MouseOver = (0 &lt;= X) And (X &lt;= Picture1.Width) And
        (0 &lt;= Y) And (Y &lt;= Picture1.Height)<br>
        If MouseExit Then<br>
        ........ <br>
        SetCapture Picture1.hWnd<br>
        Else<br>
        ........ <br>
        ReleaseCapture<br>
        End If <br>
        <a href="#home">返回</a></p>
        </td>
    </tr>
</table>
</center></div>

<hr>
<div align="center"><center>

<table border="0" width="88%">
    <tr>
        <td width="80%"><p align="left"><a
        href="vbtips.htm#Return">[1]</a> <a href="vbtips1.htm">[2]</a>
        <a href="vbtips2.htm">[3]</a> [4] <a href="vbtips4.htm">[5]</a>
        <a href="vbtips5.htm">[6]</a> <a href="vbtips7.htm">[7]</a>
        <a href="#home">[8]</a> <a href="vbtips9.htm">[9]</a> <a
        href="vbtips10.htm">[10]</a></p>
        </td>
        <td><p align="right"><font size="2">第四页(共十页)</font></p>
        </td>
    </tr>
</table>
</center></div>
</body>
</html>